Macro para enviar rango de celdas como imagen en el Outlook

Tengo el siguiente código que no me funciona para enviar un rango de celdas como imagen en un correo:

Sub Enviarcorreo_Click()
Range("A2:D62").Select
With Selection.Font
.ColorIndex = xlAutomatic
.TintAndShade = 0
End With
Range("A2:D62").Copy
Set dam = CreateObject("outlook.application").createitem(0)
dam.To = Range("J5").Value
dam.Cc = Range("J6").Value
dam.Subject = Range("J4").Value
dam.display
'Application.SendKeys "^v"
Application.Wait Now + TimeValue("00:00:01")
SendKeys "^{home}", True
DoEvents
SendKeys "%nvo", True
DoEvents
SendKeys "{UP}", True
DoEvents
SendKeys "{UP}", True
DoEvents
SendKeys "{ENTER}", True
Set dam = Nothing
End Sub

Quien me pueda ayudar a revisar que tiene malo.