Note: The other languages of the website are Google-translated. Back to English

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

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

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


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

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日間の返金保証。
kteタブ201905

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

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

 

 

コメントを並べ替える
コメント (13)
まだ評価はありません。 最初に評価してください!
このコメントは、サイトのモデレーターによって最小化されました
チャート名を入力すると、メールが生成されないダイアログボックスが閉じるだけですが、何を間違えたのでしょうか。 私は各ステップに従いました
このコメントは、サイトのモデレーターによって最小化されました
問題は、テーブルのようなチャートオブジェクトの名前を設定できないことです。 動作させるには整数IDを渡す必要があります。 たとえば、「Sheet1」にグラフが1つしかない場合、msgboxが表示されたときに値1を渡そうとします。

PS:悪い英語でごめんなさい:]
このコメントは、サイトのモデレーターによって最小化されました
hola como puede enviar por correo、unatabladinámica、ynoungráfico
このコメントは、サイトのモデレーターによって最小化されました
コードにエラーがあります: "\")+ 1)& 「」 " width = 700 height = 50太字のテキストでは、真ん中のテキストは単一引用符である必要があります

このコメントは、サイトのモデレーターによって最小化されました
添付ファイルとしてチャートが含まれています。 メール本文自体に画像として含める方法を知っていますか。 ありがとう、Youssef
このコメントは、サイトのモデレーターによって最小化されました
同じ問題、解決策はありますか?
このコメントは、サイトのモデレーターによって最小化されました
こんにちは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
このコメントは、サイトのモデレーターによって最小化されました
こんにちは、
mi nic sie nie załącza, czy coś tutaj należałoby wpisać jeszcze?
xPath = "co tutaj trzeba wprowadzić?"
このコメントは、サイトのモデレーターによって最小化されました
くばさん、こんにちは。
を削除してください / タグを付ける <img src="/.
エラーはサイトの編集者が原因です。
ご迷惑をおかけして申し訳ありません。
このコメントは、サイトのモデレーターによって最小化されました
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を設定します
このコメントは、サイトのモデレーターによって最小化されました
くばさん、こんにちは。
コードが更新されました。 受信者はチャートを正常に表示できます。 ぜひお試しください。
注意: コードの " を変更してください。チャート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
このコメントは、サイトのモデレーターによって最小化されました
こんにちは、メールの本文にスペースを入れたいのですが、どのキーワードを使用すればよいですか。
このコメントは、サイトのモデレーターによって最小化されました
こんにちは。
コード内の次の 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   文字
推奨される場所

フォローする

著作権©の2009 - WWW。extendoffice.com。 | | 全著作権所有。 搭載 ExtendOffice。 | サイトマップ
MicrosoftおよびOfficeのロゴは、米国MicrosoftCorporationの米国およびその他の国における商標または登録商標です。
SectigoSSLで保護