How can I add text to an email with screenshot pic-CodePudding

I have the following code that sends a screenshot picture of a range> I would like to add text to the email but have not been able to figure out how.

Any help would be greatly appreciated.

'''

        Public Sub ScreenShotResults2()
        Dim rng As Range
        Dim olApp As Object
        Dim Email As Object
        Dim Sht As Excel.Worksheet
        Dim wdDoc As Word.Document
    
        Set rng = Sheets("Summary").Range("B20:I34")
            rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    
        With Application
            .EnableEvents = False
            .ScreenUpdating = False
        End With
    
        Set olApp = CreateObject("Outlook.Application")
        Set Email = olApp.CreateItem(0)
        Set wdDoc = Email.GetInspector.WordEditor
    
        'strbody = "See production data for most recent 3 months.  "
    
        With Email
            .To = Worksheets("Summary").Range("B22").Value
            .Subject = "4 Month LO Production Lookback for " & Worksheets("Summary").Range("B22").Value
            '.HTMLBody = "<BODY style=font-size:12.5pt;font-family:Calibri>" & "</p>" & strbody & RangetoHTML(rng) & Signature
            .Display
        
            wdDoc.Range.PasteAndFormat Type:=wdChartPicture
    
            'if need setup inlineshapes hight & width
             With wdDoc
                .InlineShapes(1).Height = 250
             End With
    
            .Display
        End With
    
        With Application
            .EnableEvents = True
            .ScreenUpdating = True
        End With
    
        Set Email = Nothing
        Set olApp = Nothing
End Sub

CodePudding user response：

There are several ways to add the text. Here is one:

    'if need setup inlineshapes hight & width
    With wdDoc
        .InlineShapes(1).Height = 250
        .Paragraphs.Add
        .Paragraphs.Add
        .Content.InsertAfter "Please look at the range image!"
    End With

EDIT: here is an expanded example to add text before and after the image (without using RangeToHTML)

Option Explicit

Public Sub ScreenShotResults2()
    Dim rng As Range
    Set rng = Sheets("Summary").Range("B20:I34")
    rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    
    Dim olApp As Outlook.Application
    Dim Email As Outlook.MailItem
    Dim wdDoc As Word.Document
    Set olApp = CreateObject("Outlook.Application")
    Set Email = olApp.CreateItem(0)
    Set wdDoc = Email.GetInspector.WordEditor
    
    With Email
        .To = Worksheets("Summary").Range("B22").Value
        .Subject = "4 Month LO Production Lookback for " & _
                   Worksheets("Summary").Range("B22").Value
        .Display
    End With
    
    With wdDoc.Content
        '--- paste the range image first, because it overwrites
        '    everything in the document
        .PasteAndFormat Type:=wdChartPicture
        
        '--- now add our greeting at the start of the email
        .InsertBefore "Dear Goober," & vbCr & vbCr & _
                      "See production data for most recent 3 months.  " & _
                      vbCr & vbCr
                                   
        '--- finally add our sign off after the image
        .InsertAfter vbCr & vbCr & _
                     "This is my final comment." & vbCr & vbCr & _
                     "Sincerely," & vbCr & _
                     "Me!"
    End With
    
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
    
    Set Email = Nothing
    Set olApp = Nothing
End Sub