By ゲスト 01年2018月XNUMX日土曜日
投稿: Kutools for Excel
返信 0
いいね 0
ビュー 2.7K
投票 0
仕事のプロジェクトを支援するために kutools をインストールしました。 また、入力された情報から電子メールを作成するマクロを備えた大規模な企業レポートも管理しています。 そのマクロは私のコンピュータでは動作しなくなりました。 kutoolsを持たないコンピューターでも動作します。 これまでにこのようなことに遭遇した人はいますか? 他のコンピュータでは正常に動作するマクロを次に示します。

サブ Mail_Sheet_Outlook_Body()
'Excel 2000 ~ 2016 での作業
Application.ReferenceStyle = xlA1
範囲として暗くする
オブジェクトとしての薄暗いOutApp
オブジェクトとしてOutMailを暗くする
文字列としての薄暗いxFolder
ワークシートとして薄暗いxSht
文字列としての Dim xSub
文字列としてのディム応答
文字列としての薄暗いメッセージ
文字列としてのディムスタイル
文字列としての薄暗いタイトル

xSht=ActiveSheetに設定します
Msg = 「このフォームを電子メールで送信してもよろしいですか?」 ' メッセージを定義します。
Style = vbYesNo + vbCritical + vbDefaultButton2 ' ボタンを定義します。
Title = "メール送信確認" ' タイトルを定義します。
応答 = MsgBox(メッセージ, スタイル)

応答=vbYesの場合
xFolder = Environ("USERPROFILE") + "\デスクトップ\" + "\フィールド監査フォーム--" + CStr(xSht.Cells(19, "A").Value) + "--.pdf"
'xSub = "ストアのフィールド監査 " + CStr(xSht.Cells(19, "A").Value)
アプリケーション付き
.EnableEvents = False
.ScreenUpdating = False
最後に

rng = なしを設定します
rng = ActiveSheet.usedRange を設定します
'シート名を使用することもできます
'Set rng = Sheets("YourSheet").usedRange

Set OutApp = CreateObject( "Outlook.Application")
OutMail = OutApp.CreateItem(0)を設定します
Dim varCellvalue As Long




エラーで次の再開
OutMailで
.To = ""
.CC = ""
.BCC = ""
.Subject = "要約"
.Attachments.AddxFolder
.HTMLBody = RangetoHTML(rng)
.Display 'または .Display を使用します

最後に
エラー時GoTo0

アプリケーション付き
.EnableEvents = True
.ScreenUpdating = True
最後に

OutMail=Nothingを設定します
OutApp=Nothingを設定します
終了する場合
End Subの


関数 RangetoHTML(rng As Range)
' Office 2000 ~ 2016 での作業
オブジェクトとしての薄暗いfso
オブジェクトとしての寸法
文字列としての Dim TempFile
ワークブックとしての Dim TempWB

TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

'範囲をコピーし、データを貼り付ける新しいワークブックを作成します
rng.コピー
TempWB = Workbooks.Add(1) を設定します。
TempWB.Sheets を使用する(1)
.Cells(1).Paste特殊ペースト:=8
.Cells(1).PasteSpecial xlPasteValues、、False、False
.Cells(1).PasteSpecial xlPasteFormats、、False、False
.Cells(1).選択
Application.CutCopyMode = False
エラーで次の再開
.DrawingObjects.Visible = True
.DrawingObjects.Delete
エラー時GoTo0
最後に

'シートをhtmファイルにパブリッシュします
TempWB.PublishObjects.Add( _ を使用)
SourceType:=xlSourceRange, _
ファイル名:=TempFile, _
Sheet:=TempWB.Sheets(1).Name, _
ソース:=TempWB.Sheets(1).usedRange.Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
最後に

'htm ファイルからすべてのデータを RangetoHTML に読み込みます
Set fso = CreateObject( "Scripting.FileSystemObject")
ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2) を設定します。
RangetoHTML = ts.readall
ts.閉じる
RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=, _
"align=left x:publishsource=")

'TempWB を閉じる
TempWB.Close savechanges:=False

'この関数で使用したhtmファイルを削除します
一時ファイルを強制終了する
ts = 何も設定しない
fso=Nothingを設定します
TempWB = 何も設定しない

エンド機能
投稿全体を見る