Hi, I tried to copy range from excel sheet and paste in to body of the email. It worked but i also have an image in my excel , i want to copy image from excel and wants to paste body of email along with range as image

Here is my code, please help me out
Sub Main()

    Dim OutApp As Object
    Dim OutMail As Object

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    
Sheet1.Activate

Set mainSheet = Worksheets("Database")
lastinput = lastrow(mainSheet)
todaydate = "04-06-1984"
For Birth = 2 To lastinput
    birthdate = Trim(Sheet1.Cells(Birth, 5))
    If birthdate = todaydate Then
        Name = Sheet1.Cells(Birth, 2)
        toadd1 = Sheet1.Cells(Birth, 1)
        toadd2 = Sheet1.Cells(Birth, 7)
        Sheet1.Cells(2, 9) = toadd2
        toadd3 = Sheet1.Cells(2, 10)
        Sheet1.Cells(2, 9) = toadd3
        toadd4 = Sheet1.Cells(2, 10)

        rng = ActiveSheet.Range("A1:K21").Select
        
        Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
        On Error Resume Next
        With OutMail
            .To = toadd1
            .CC = toadd2
            .BCC = ""
            .Subject = "Hi" & " " & fromadd & " - Happy Birthday"
              
            .Body = rng.PasteSpecial(Placement:=wdInLine, DataType:=wdPasteBitmap)

            .display
        End With
        On Error GoTo 0
    End If
Next Birth
Set OutMail = Nothing
Set OutApp = Nothing
End Sub


Function lastrow(wkSheet As Worksheet) As Integer

    With wkSheet
    On Error Resume Next
    lastrow = .Cells.Find("*", .Cells(1), xlFormulas, _
    xlWhole, xlByRows, xlPrevious).Row
    If Err <> 0 Then lastrow = 0
    
    End With