محتاج كود ( ماكرو ) لتصدير ورقة اكسيل الي صورة

[ashraf helmy]

السلام عليكم ورحمه الله وبركاته
الأعضاء المحترمين بعد اذن حضرتكم

محتاج كود ( مكروا ) لتحويل ورقة اكسيل الي صورة

تصدير الصفحة الي صورة ( JPG )

[أ / محمد صالح]

يمكنك استعمال هذا الكود 

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

بالتوفيق 

[ashraf helmy]

جزاك الله كل خير وربنا يجعله في ميزان حسناتك

[أ / محمد صالح]

جميعا بإذن الله 

[sabah20267]

السلام عليكم

اين يتم حفظ الصورة؟

 

[أ / محمد صالح]

يبدو أن حضرتك ما لاحظت هذا الجزء 

Filename:=ThisWorkbook.Path & "\mas.jpg"

وهو يعني 

في نفس مسار المصنف

باسم mas. jpg

[sabah20267]

اعتذر - صحيح .. ممكن طلب .. حفظ الصورة على اساس الاسم الذي هو موجود في خلية B3

 

 

[أ / محمد صالح]

في هذه الحالة نستبدل كلمة mas بمرجع الخلية المطلوبة

أمر التصدير 

.Export Filename:=ThisWorkbook.Path & "\mas.jpg", Filtername:="JPG"

يتم تغييره إلى 

.Export Filename:=ThisWorkbook.Path & "\" & [b3] & ".jpg", Filtername:="JPG"

 

بالتوفيق

[sabah20267]

نجح الأمر

100 %

تسلم

 

[أ / محمد صالح]

سلمكم الله من كل سوء