Sayfalardan belirli aralığı resim olarak mail atmak

[yasartomurcuk]

Merhaba

Ekteki örnek dosyamda aşağıdaki kodlar ile GRAFİK sayfasındaki belli alanı mail gövdesine resim olarak yapıştıra biliyorum
Ancak istiyorum ki METİN sayfasından mailin konusunu ve gövde metnine yazılacakları alsın BANKA - GRAFİK - MALİ HAFIZA sayfalarından belli hücre aralığını resim olarak mail gövdesine yapıştırabilsin

Örnek dosyamdaki makroyu çalıştırdığınızda ne yapmak istediğimi anlayabilirsiniz yada şuanki kullandığım koddaki formatta mail atmak istiyorum

yardımlarınız için teşekkürler

Sub kod()

Dim S1 As Worksheet: Set S1 = Sheets("grafik&web report farkları")
Dim rng As Range, cht As ChartObject, say As Double, obj As Object
Const strPath As String = "C:\resim\"

With Application
.EnableEvents = False
.ScreenUpdating = False
End With
S1.Select
isim = "mailek_" & Format(Now, "ddmmyyhhmmss")
Set obj = CreateObject("Scripting.FileSystemObject").GetFold er(strPath)
say = obj.Files.Count + 1
Set rng = S1.Range("A1:S38")

rng.CopyPicture xlScreen, xlPicture
Set cht = ActiveSheet.ChartObjects.Add(0, 0, rng.Width + 10, rng.Height + 10)
cht.Chart.Paste
cht.Chart.Export strPath & isim & ".jpg"
cht.Delete
ExitProc:
Set obj = Nothing: Set rng = Nothing: Set cht = Nothing

Dim xlOutlook As Object
Dim xlMail As Object
Set xlOutlook = CreateObject("Outlook.Application")
Set xlMail = xlOutlook.CreateItem(0)
htmlyaz = "<img src=" & strPath & isim & ".jpg" & " alt=''"

With xlMail
.To = Range("y3").Value
.CC = Range("y4").Value
.Subject = Range("e3").Value
.HTMLBody = htmlyaz
.Importance = 2
.Save
.Display
'.Send
End With

Set xlMail = Nothing
Set xlOutlook = Nothing
Kill strPath & isim & ".jpg"

With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub