メール本文にExcel表を図として貼り付け

投稿者 : 初心者KM     投稿日時 : 2023/06/14(Wed) 20:09:36     OS : Windows 10     EXCEL : Excel 2019

---

Excel VBA メール（outlook）作成について
本文の中にExcel でコピーした表を上下に2つ
図として貼り付けをしたいです。

Range("D7")セル
（本文）<br><br>
【PT1】<br><br>
【PT2】

【PT1】【PT2】をそれぞれ図に置き換えたところ、
それぞれの位置に上手く置き換えができず、【PT1】の位置に【PT2】の図だけが貼り付けされていました。

詳しい方教えて頂けると幸いです。
宜しくお願い致します。

Sub メール作成
Dim outlookObj As Outlook.Application
  Set outlookObj = New Outlook.Application
 
  Dim mailObj As Outlook.MailItem
  Set mailObj = outlookObj.CreateItem(olMailItem)
 
  mailObj.Display
 
  Worksheets("リスト").Activate
 
  Dim mailBody As String
  mailBody = CreatemailBody
 
  With mailObj
    .To = Range("D5")
    .CC = Range("D6")
    .Subject = Range("D4")
    .HTMLBody = mailBody
  End With
 
    Dim objWRG As Word.Range
    Set objWRG = mailObj.GetInspector.WordEditor.Range(0, 0)
    With objWRG
        Worksheets("1").Range("A1:Z30").CopyPicture
        .Find.Text = "【PT1】"
        .Find.Execute
        .PasteSpecial
        .ShapeRange.Width = 900#
      Worksheets("2").Range("A3:AZ28").CopyPicture
        .Find.Text = "【PT2】"
        .Find.Execute
        .PasteSpecial
        .ShapeRange.Width = 900#
    End With
 
End Sub
 
Function CreatemailBody() As String
 
    Dim Body As String
    Dim Day As String
 
    Body = Range("D7")
    Body = Replace(Body, "【月】", Day)
    CreatemailBody = Body
 
End Function

投稿者 : さんこう     投稿日時 : 2023/06/15(Thu) 08:30:36

---

＞【PT1】の位置に【PT2】の図だけが貼り付けされ

Outlookを使っていないのでよくわかりませんが、

マイクロソフトのドキュメント↓に、
https://learn.microsoft.com/ja-jp/office/vba/api/word.find

「Range オブジェクトから Find オブジェクトを取得した場合、検索条件と一致する文字列が見つかっても選択範囲は変更されませんが、Range オブジェクトが再定義されます。」

とありますので、【PT1】を見つけた時点で「objWRG」が変更されてしまうようです。

【PT2】を検索する前に、もう一度「Set objWRG = ・・・」を実行してみてはいかがでしょうか。

投稿者 : 初心者km     投稿日時 : 2023/06/19(Mon) 08:11:28

---

■[返信 1] さんこうさん（2023-06-15 08:30:36）の記事
＞ ＞【PT1】の位置に【PT2】の図だけが貼り付けされ
＞
＞ Outlookを使っていないのでよくわかりませんが、
＞
＞ マイクロソフトのドキュメント↓に、
＞ https://learn.microsoft.com/ja-jp/office/vba/api/word.find
＞
＞ 「Range オブジェクトから Find オブジェクトを取得した場合、検索条件と一致する文字列が見つかっても選択範囲は変更されませんが、Range オブジェクトが再定義されます。」
＞
＞ とありますので、【PT1】を見つけた時点で「objWRG」が変更されてしまうようです。
＞
＞ 【PT2】を検索する前に、もう一度「Set objWRG = ・・・」を実行してみてはいかがでしょうか。
＞

解決しました。ありがとうございます。
objWRG変更されてしまうんですね。
助かりましたm(_ _)m