VBAでメール送信について

投稿者 : VBA勉強中     投稿日時 : 2022/05/24(Tue) 13:09:52     OS : Windows 10     EXCEL : Excel 2019

---

お世話になります。
Excel VBAについて皆様のお力をお借りできたと思い質問致しました。

やりたいこと：
①VBAでセル内容を画像として、貼り付けて、Outlookを起動し送信する。
②”引継ぎ連絡表”の全セル内容（A1:N41）を画像としてコピーし、Outlook本文に貼り付ける
③”メール設定（引継ぎ連絡表）”で、宛先・件名・本文など指定

上記の内容は、下記のコードで出来たのですが、追加で、別シート（2枚）の内容も、引継ぎ連絡表の下に同じく画像として貼り付けたいです。
勤怠報告の2枚は、2枚とも範囲A1：O25になります。

可能でしょうか？
また、下記のコードだと、
Worksheets("引継ぎ連絡表").Activateで一度Activeにしないと、うまく動作しません…
ws○と定義して、やると.Shapes(Selection.ShapeRange.Name)でオブジェクトエラーがでますので、そこもご指導いただけたらと思います。

お手数をおかけしますが、よろしくお願いいたします。

Sub Mail ()
Dim ws1 As Worksheet
Set ws1 = Worksheets("メール設定（引継ぎ連絡表）")
Dim Ap As Object
Dim M As Object
Set Ap = CreateObject("Outlook.Application")
Set M = Ap.CreateItem(0)
Dim subject As String, mailbody As String, attachedfile As String
Dim i As Long
Dim mailaddress As Variant, maillist As String
 
With ws1
　mailaddress = .Range("B7:B16").Value
　For i = LBound(mailaddress) To UBound(mailaddress)
　　maillist = maillist & ";" & mailaddress(i, 1)
　Next
End With
 
　subject = Replace(ws1.Range("B2").Value, "{日付}", Date)
　mailbody = ws1.Range("B3").Value
　attachedfile = ws1.Range("B4").Value
 
　M.BodyFormat = 2
　M.subject = subject
　M.To = maillist
 
Worksheets("引継ぎ連絡表").Activate
　　Range("A1:N41").CopyPicture Appearance:=xlScreen, Format:=xlPicture
　　Range("A1").Select
　ActiveSheet.Pictures.Paste.Select
With ActiveSheet.Shapes(Selection.ShapeRange.Name)
　.Width = 800
　.Height = 600
End With
　ActiveSheet.Shapes(Selection.ShapeRange.Name).Copy
 
　With M.GetInspector.WordEditor.Windows(1).Selection
　　TypeText = mailbody
　　　.TypeText Chr(13)
　　　　.Paste
　End With
　If attachedfile <> "" Then
   　 M.Attachments.Add (ThisWorkbook.Path & "\" & attachedfile)
　End If
 
　M.Display
　　Application.Wait Now() + TimeValue("00:00:05")
　　　'M.Send　←わざとコメントアウトしてます
　ActiveSheet.Shapes(Selection.ShapeRange.Name).Delete
　　Application.CutCopyMode = False
End Sub

投稿者 : VBA勉強中     投稿日時 : 2022/05/24(Tue) 14:52:48

---

こちらについては、解決しました。ありがとうございました。