Copying and Sending

This copies a cell range and saves a picture of it to a local folder.

Public Sub SaveRangeAndSend() 
   Call SaveRangePic(Range("A1:B20"), "C:\Temp\myFile.png") 
   Call SendEmail("C:\Temp\myFile.png", "myFile.png") 
End Sub 

This code saves the cell range to an image file.

Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long 
Private Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal wFormat As Integer) As Long 
Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long 
Private Declare PtrSafe Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As uPicDesc, _ 
   RefIID As uGUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long 

Private Type uGUID 
    Data1 As Long 
    Data2 As Integer 
    Data3 As Integer 
    Data4(0 To 7) As Byte 
End Type 

Private Type uPicDesc 
    Size As Long 
    Type As Long 
    hPic As Long 
    hPal As Long 
End Type 

Public Sub SaveRangePic(ByVal SourceRange As Range, _ 
                        ByVal sFilePathName As String) 
Dim IID_IDispatch As uGUID 
Dim uPicInfo As uPicDesc 
Dim IPic As IPicture 
Dim hPtr As Long 
   On Error GoTo ErrorHandler 
   SourceRange.CopyPicture Appearance:=xlScreen, Format:=xlBitmap 
   OpenClipboard 0 
   hPtr = GetClipboardData(2) 
   CloseClipboard 
   With IID_IDispatch 
       .Data1 = &H7BF80980 
       .Data2 = &HBF32 
       .Data3 = &H101A 
       .Data4(0) = &H8B 
       .Data4(1) = &HBB 
       .Data4(2) = &H0 
       .Data4(3) = &HAA 
       .Data4(4) = &H0 
       .Data4(5) = &H30 
       .Data4(6) = &HC 
       .Data4(7) = &HAB 
   End With 
   With uPicInfo 
       .Size = Len(uPicInfo) 
       .Type = 1 
       .hPic = hPtr 
       .hPal = 0 
   End With 
   OleCreatePictureIndirect uPicInfo, IID_IDispatch, True, IPic 
   stdole.SavePicture IPic, sFilePathName 
   Exit Sub 
ErrorHandler: 
    MsgBox (Err.Number & " - " & Err.description) 
End Sub 

This code creates an Outlook email and embeds an image into the email body.
You need to add a reference to the Microsoft Office 16.0 Object Library.

Public Sub SendEmail(ByVal sFullPath As String, _ 
                     ByVal sFileName As String) 
Dim oOutlookApp As Outlook.Application 
Dim oMailItem As Outlook.MailItem 

    Set oOutlookApp = CreateObject("Outlook.Application") 
    Set oMailItem = oOutlookApp.CreateItem(OlItemType.olMailItem) 
    
    With oMailItem 
        .Subject = "mytitle" 
        .HTMLBody = "add some text<BR><BR><IMG src=""cid:" & sFileName & """>" 
        .Recipients.Add "myname@bettersolutions.com" 
        .Attachments.Add sFullPath, Type:=OlAttachmentType.olEmbeddeditem, Position:=0 
    End With 
    
    oMailItem.Display 
    'oMailItem.Send
   Exit Sub 
ErrorHandler: 
    MsgBox (Err.Number & " - " & Err.description) 
End Sub