Excelでvbaを使用して特定のグラフを電子メールで送信するにはどうすればよいですか？

VBAコードを使用してExcelのOutlookから電子メールを送信する方法を知っているかもしれません。ただし、特定のワークシートの特定のグラフをメールの本文に添付する方法を知っていますか？この記事では、この問題を解決する方法を紹介します。

VBAコードを使用してExcelの電子メールで特定のグラフを送信する

VBAコードを使用してExcelの電子メールで特定のグラフを送信する

すごい！ Chrome、Firefox、SafariなどのExcelで効率的なタブを使用する！

時間の50％を節約し、毎日何千ものマウスクリックを減らしましょう！

ExcelでVBAコードを含む特定のグラフをメールで送信するには、次のようにしてください。

1.メール本文に添付するグラフが含まれているワークシートで、を押します。他の + F11 キーを押して アプリケーション向け Microsoft Visual Basic 窓。

2。の中に アプリケーション向け Microsoft Visual Basic ウィンドウをクリックしてください インセット > モジュール。次に、以下のVBAコードを[コード]ウィンドウにコピーします。

VBAコード：Excelの電子メールで特定のグラフを送信します

Sub mailHTMLsend()
'Updated by Extendoffice 2018/3/5
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xStartMsg As String
    Dim xEndMsg As String
    Dim xChartName As String
    Dim xChartPath As String
    Dim xPath As String
    Dim xChart As ChartObject
    On Error Resume Next
    xChartName = Application.InputBox("Please enter the chart name:", "KuTools for Excel", , , , , , 2)
    If xChartName = "" Then Exit Sub
    Set xChart = Sheets("Sheet1").ChartObjects(xChartName) 'Change "Sheet1" to your worksheet name
    If xChart Is Nothing Then Exit Sub
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    xStartMsg = "<font size='5' color='black'> Good Day," & "<br> <br>" & "Please find the chart below: " & "<br> <br> </font>"
    xEndMsg = "<font size='4' color='black'> Many Thanks," & "<br> <br> </font>"
    xChartPath = Application.ActiveWorkbook.Path & "\" & Environ("USERNAME") & VBA.Format(VBA.Now(), "DD_MM_YY_HH_MM_SS") & ".bmp"
    xPath = "<p align='Left'><img src=" & "cid:" & Mid(xChartPath, InStrRev(xChartPath, "\") + 1) & """  width=700 height=500 > <br> <br>"
    xChart.Chart.Export xChartPath
    With xOutMail
        .To = "xrr@163.com"
        .Subject = "Add Chart in outlook mail body"
        .Attachments.Add xChartPath
        .HTMLBody = xStartMsg & xPath & xEndMsg
        .Display
    End With
    Kill xChartPath
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub

注意：コードで、受信者のメールアドレスとメールの件名を行で変更してください .To = "xrr@163.com" と行 .Subject = "Outlookのメール本文にグラフを追加" , Sheet1 送信したいチャートが入っているシートですので、自分のものに変更してください。

3。プレス F5 コードを実行するためのキー。オープニングで Kutools for Excel ダイアログボックスで、添付するグラフの名前をメール本文に入力し、[ OK ボタン。スクリーンショットを参照してください：

次に、以下のスクリーンショットに示すように、指定したグラフがメール本文に表示されたメールが自動的に作成されます。このメールを送信するには、[送信]ボタンをクリックしてください。

最高のオフィス生産性ツール

Kutools for Excelはほとんどの問題を解決し、生産性を80％向上させます

再利用: すばやく挿入 複雑な数式、チャート および以前に使用したものすべて。セルを暗号化するパスワード付き。メーリングリストを作成するそしてメールを送る...
スーパーフォーミュラバー（複数行のテキストと数式を簡単に編集できます）; 読書レイアウト（多数のセルを簡単に読み取って編集する）; フィルター範囲に貼り付け...
セル/行/列をマージするデータを失うことなく; 分割セルコンテンツ; 重複する行/列を組み合わせる...重複セルを防止します。範囲を比較する...
[複製]または[一意]を選択します行; 空白行を選択（すべてのセルは空です）; スーパーファインドとファジーファインド多くのワークブックで; ランダム選択...
正確なコピー数式参照を変更せずに複数のセル。参照の自動作成複数のシートに; 箇条書きを挿入、チェックボックスなど...
テキストを抽出、テキストの追加、位置による削除、スペースを削除する; ページング小計の作成と印刷。セルの内容とコメントを変換する...
スーパーフィルター（フィルタースキームを保存して他のシートに適用します）; 高度な並べ替え月/週/日、頻度など。特殊フィルター太字、斜体...
ワークブックとワークシートを組み合わせる; キー列に基づいてテーブルをマージします。データを複数のシートに分割; xls、xlsx、PDFをバッチ変換...
300 以上の強力な機能. Office / Excel 2007-2021 および 365 をサポートします。すべての言語をサポートします。企業や組織に簡単に導入できます。フル機能の 30 日間無料トライアル。 60日間の返金保証。

続きを読みます... 無料ダウンロード... 購入...

Officeタブは、タブ付きのインターフェイスをOfficeにもたらし、作業をはるかに簡単にします

Word、Excel、PowerPointでタブ付きの編集と読み取りを有効にする、パブリッシャー、アクセス、Visioおよびプロジェクト。
新しいウィンドウではなく、同じウィンドウの新しいタブで複数のドキュメントを開いて作成します。
生産性を 50% 向上させ、毎日何百回もマウスクリックを減らすことができます!

続きを読みます... 無料ダウンロード... 購入...

コメント (13)

まだ評価はありません。最初に評価してください！

リー

約3年前

#29338

このコメントは、サイトのモデレーターによって最小化されました

チャート名を入力すると、メールが生成されないダイアログボックスが閉じるだけですが、何を間違えたのでしょうか。私は各ステップに従いました

返信

ボルヘスリー

約3年前

#29339

このコメントは、サイトのモデレーターによって最小化されました

問題は、テーブルのようなチャートオブジェクトの名前を設定できないことです。動作させるには整数IDを渡す必要があります。たとえば、「Sheet1」にグラフが1つしかない場合、msgboxが表示されたときに値1を渡そうとします。

PS：悪い英語でごめんなさい：]

返信

アーロン・マンケオ

約3年前

#30497

このコメントは、サイトのモデレーターによって最小化されました

hola como puede enviar por correo、unatabladinámica、ynoungráfico

返信

ニティン・シャルマ

約1年前

#35033

このコメントは、サイトのモデレーターによって最小化されました

コードにエラーがあります： "\"）+ 1）＆ 「」 " width = 700 height = 50太字のテキストでは、真ん中のテキストは単一引用符である必要があります

返信

ユセフ

約1年前

#35531

このコメントは、サイトのモデレーターによって最小化されました

添付ファイルとしてチャートが含まれています。メール本文自体に画像として含める方法を知っていますか。ありがとう、Youssef

返信

J ユセフ

約7ヶ月前

#38720

このコメントは、サイトのモデレーターによって最小化されました

同じ問題、解決策はありますか？

返信

結晶 J

約7ヶ月前

#38782

このコメントは、サイトのモデレーターによって最小化されました

こんにちはJ、
コードが更新されました。ぜひお試しください。ご不便おかけしてすみません。


Sub mailHTMLsend()
'Updated by Extendoffice 2018/3/5
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xStartMsg As String
    Dim xEndMsg As String
    Dim xChartName As String
    Dim xChartPath As String
    Dim xPath As String
    Dim xChart As ChartObject
    On Error Resume Next
    xChartName = Application.InputBox("Please enter the chart name:", "KuTools for Excel", , , , , , 2)
    If xChartName = "" Then Exit Sub
    Set xChart = Sheets("Sheet1").ChartObjects(xChartName) 'Change "Sheet1" to your worksheet name
    If xChart Is Nothing Then Exit Sub
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    xStartMsg = "<font size='5' color='black'> Good Day," & "<br> <br>" & "Please find the chart below: " & "<br> <br> </font>"
    xEndMsg = "<font size='4' color='black'> Many Thanks," & "<br> <br> </font>"
    xChartPath = Application.ActiveWorkbook.Path & "\" & Environ("USERNAME") & VBA.Format(VBA.Now(), "DD_MM_YY_HH_MM_SS") & ".bmp"
    xPath = "<p align='Left'><img src="/%20&%20"cid:" & Mid(xChartPath, InStrRev(xChartPath, "\") + 1) & """  width=700 height=500 > <br> <br>"
    xChart.Chart.Export xChartPath
    With xOutMail
        .To = "xrr@163.com"
        .Subject = "Add Chart in outlook mail body"
        .Attachments.Add xChartPath
        .HTMLBody = xStartMsg & xPath & xEndMsg
        .Display
    End With
    Kill xChartPath
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub

返信

レポート

キューバ結晶

約6ヶ月前

#39111

このコメントは、サイトのモデレーターによって最小化されました

こんにちは、
mi nic sie nie załącza, czy coś tutaj należałoby wpisać jeszcze?
xPath = "co tutaj trzeba wprowadzić?"

返信

結晶キューバ

約6ヶ月前

#39188

このコメントは、サイトのモデレーターによって最小化されました

くばさん、こんにちは。
を削除してください / タグを付ける <img src="/.
エラーはサイトの編集者が原因です。
ご迷惑をおかけして申し訳ありません。

返信

レポート

キューバ結晶

約4ヶ月前

#40449

このコメントは、サイトのモデレーターによって最小化されました

cześć, pełny kod działa tylko do momentu podglądu komunikatu, przy wysyłce adresat otrzymuje błąd i wykresu nie widać ("Nie można wyświetlić połączonego obrazu. Plik mógł zostać przeniesiony lub usunięty albo zmieniono jego nazwę. Sprawdź czy łącze wskazuje poprawny plik i lokazlizację.") Czy z Was też tak ktoś miał czy tylko u mnie taki zonk? Prosze o pomoc、tutaj kod、który dotyczy wykresum już tak mało brakuje :)

Dim xChartName を文字列として
Dim xChartPath を文字列として
文字列としてのDimxPath
xChart を ChartObject として薄暗い
エラーで次の再開
Dim wydzialy As String
wydzialy = lista.Cells(3, 75)
xChartName = Application.InputBox(wydzialy, "KuTools for Excel", , , , 2) 'Wykres1 '"チャート名を入力してください:"
If xChartName = "" Then Exit Sub
Set xChart = Sheets("Wykresy").ChartObjects(xChartName) '「Sheet1」をワークシート名に変更
xChart が何もない場合は、Sub を終了します
xChartPath = Application.ActiveWorkbook.Path & "\" & Environ("USERNAME") & VBA.Format(VBA.Now(), "DD_MM_YY_HH_MM_SS") & ".svg" '.bmp '.svg '.svg ma lepsza jakość
xPath = " "
xChart.Chart.Export xChartPath

オブジェクトとしての薄暗いOutApp
オブジェクトとしてOutMailを暗くする
Set OutApp = CreateObject（ "Outlook.Application"）
OutMail = OutApp.CreateItem（0）を設定します
OutMailで
.To = メール(b)
.CC = email_dw(b)
.Subject = "XXXX" ' - " & lista.Cells(i, 66)
.Attachments.Add xChartPath
.HTMLBody = "treść" & xPath

.SendUsingAccount = OutApp.Session.Accounts.Item(1) を設定します。

。表示
最後に
xChartPath を終了する
OutMail=Nothingを設定します
OutApp=Nothingを設定します

結晶キューバ

約3ヶ月前

#40672

このコメントは、サイトのモデレーターによって最小化されました

くばさん、こんにちは。
コードが更新されました。受信者はチャートを正常に表示できます。ぜひお試しください。
注意: コードの " を変更してください。チャート1」を独自のチャート名に変更し、To フィールドに電子メールアドレスを指定します。

Sub mailHTMLsend()
'Updated by Extendoffice 20221013
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xStartMsg As String
    Dim xEndMsg As String
    Dim xChartName 'As String
    Dim xChartPath As String
    Dim xPath As String
    Dim xChart As ChartObject
    On Error Resume Next
    xChartName = "Chart 1" 'The name of the chart in the current worksheet you want to send.
    If xChartName = "" Then Exit Sub
    Set xChart = Application.ActiveSheet.ChartObjects(xChartName)
    If xChart Is Nothing Then Exit Sub
    
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    
    xStartMsg = "<font size='5' color='black'> Good Day," & "<br> <br>" & "Please find the chart below: " & "<br> <br> </font>"
    xEndMsg = "<font size='4' color='black'> Many Thanks," & "<br> <br> </font>"
    xChartPath = Application.ActiveWorkbook.Path & "\" & Environ("USERNAME") & VBA.Format(VBA.Now(), "DD_MM_YY_HH_MM_SS") & ".bmp"
    
    xPath = "<p align='Left'><img src="/%20&%20"cid:" & Mid(xChartPath, InStrRev(xChartPath, "\") + 1) & """  width=700 height=500 > <br> <br>"
    
    xChart.Chart.Export xChartPath
    With xOutMail
        .To = "Email Address"
        .Subject = "Add Chart in outlook mail body"
        .Attachments.Add xChartPath
        .HTMLBody = xStartMsg & xPath & xEndMsg
        .Display
    End With
    Kill xChartPath
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub

返信

レポート

パバン・チョーグル

約2ヶ月前

#41652

このコメントは、サイトのモデレーターによって最小化されました

こんにちは、メールの本文にスペースを入れたいのですが、どのキーワードを使用すればよいですか。

返信

結晶パバン・チョーグル

約1ヶ月前

#41842

このコメントは、サイトのモデレーターによって最小化されました

こんにちは。
コード内の次の XNUMX 行には、メール本文の内容が含まれています。キーボードのスペースキーを押してスペースを追加することで、電子メールの本文を手動で変更できます。

xStartMsg = "<font size='5' color='black'> Good Day," & "<br> <br>" & "Please find the chart below: " & "<br> <br> </font>"
xEndMsg = "<font size='4' color='black'> Many Thanks," & "<br> <br> </font>"

返信

レポート

ここにはまだコメントが投稿されていません

あなたのコメントを残す

ゲストとして投稿

ログイン

名前（必須）

メールアドレス（必須）

この投稿を評価：

リセット

0 文字

同意します利用規約と条件