يمكنك استعمال هذا الكود
Sub rng2jpg(Rng As Range)
Dim Chrt As ChartObject
Rng.CopyPicture xlScreen, xlPicture
Set Chrt = ActiveSheet.ChartObjects.Add(Left:=0, Top:=0, Width:=Rng.Width, Height:=Rng.Height)
Chrt.Activate
With Chrt.Chart
.Paste
.Export Filename:=ThisWorkbook.Path & "\mas.jpg", Filtername:="JPG"
End With
oChrtO.Delete
MsgBox "Done by mr-mas.com"
End Sub
ولاستدعائه
Sub mas()
rng2jpg Range("a1:f20")
End sub
وتم فصل الإجراءين لسهولة التعامل مع الكود في أكثر من شيت
ويمكن الاستغناء عن الإجراء الثاني إذا أضفنا تحديد النطاق إلى الإجراء الأول كما في السطر الثالث ليصبح
Sub rng2jpg()
Dim rng As Range, Chrt As ChartObject
Set Rng = Range("a1:f20")
Rng.CopyPicture xlScreen, xlPicture
Set Chrt = ActiveSheet.ChartObjects.Add(Left:=0, Top:=0, Width:=Rng.Width, Height:=Rng.Height)
Chrt.Activate
With Chrt.Chart
.Paste
.Export Filename:=ThisWorkbook.Path & "\mas.jpg", Filtername:="JPG"
End With
Chrt.Delete
MsgBox "Done by mr-mas.com"
End Sub
بالتوفيق