كود لحفظ مدى من الخلايا كصورة

[عبد الفتاح كيرة]

السلام عليكم

أثناء التجوال فى الإنترنت

وجدت هذا الكود

لحفظ مدى معين من الخلايا كصورة على جهازك

قد يستفيد منه بعضكم

Sub Export_Range_Images()


' =========================================

' Code to save selected Excel Range as Image

' =========================================


Dim oRange As Range

Dim oCht As Chart

Dim oImg As Picture




Set oRange = Range("A1:B2")

Set oCht = Charts.Add



oRange.CopyPicture xlScreen, xlPicture



oCht.Paste


oCht.Export FileName:="d:\SavedRange.jpg", Filtername:="JPG"


End Sub

و هذه هى صورة لمدى من صفين

[ابو الآء]

اخى الحبيب

خالص تحياتى

اتمنى ان ترفق ملف مطبق عليه هذا الكود

ثانيا

هل تتغير محتويات هذه الصورة بتغير محتويات هذة الخلايا

ان كان كذلك يمكن استفادة منها فى عمل تزييل مخصص لصفات الشيتات عند الطبع

خالص تحياتى

اخيك ابو الاء

[عبد الفتاح كيرة]

نعم أخى

يمكنك تغيير المدى من خلال السطر التالى

Set oRange = Range("A1:B2")

حسب ما تريد

[gamalin]

في البداية كود مفيد وجميل نشكر الاخ

ولكن يمكن من الاخوة خبراء الفيجوال تعديله ليصبح المدي بدلا من مدى ثابت يعدل برمجيا الى seletion range

وايضا جعل مسار الحفظ بدلا من مسار ثابت الى مسار متغير يكتب في خليه محدده واذا وجدها خالية يستخدم مسار افتراضي

عندها اعتقد ان الكود سيكون اجمل وافيد وايسر للاستخدام

حاولت جرب التعديل عليه لكني فشلت

Range("A1").Select

Range(Selection, Selection.End(xlDown)).Select

Range(Selection, Selection.End(xlToRight)).Select

Set oRange = Selection.Range

[عبدالله باقشير]

السلام عليكم

قمت بالتعديل بحيث انه يقوم بحفظ خلايا بمدى ملائم للشرت

ويقوم بحذف الشرت بعد حفظ الصورة

بدون اظهار رسالة الاكسل لتاكيد الحذف

ويتم حفظ الصورة في فولدر ملف الاكسل

هذا بشكل سريع

وساقوم بالتعديل بطرق اخرى

Sub Export_Range_Images()


' =========================================

' Code to save selected Excel Range as Image

' =========================================

Dim P

Dim oRange As Range

Dim oCht As Chart

Dim oImg As Picture


P = ActiveWorkbook.Path & "\"


Set oRange = Range("A1:O35")

Set oCht = Charts.Add


Application.ScreenUpdating = False

Application.DisplayAlerts = False

oRange.CopyPicture xlScreen, xlPicture



oCht.Paste


oCht.Export Filename:=P & "SavedRange.jpg", Filtername:="JPG"


oCht.Delete

Application.DisplayAlerts = True

Application.ScreenUpdating = True

End Sub

خبور خير

حفظ صورة من نطاق خلايا معين.rar

[عادل حنفي]

السلام عليكم

اخي خبور

الله يبارك فيك

و ما اسعدني حقيفة وجدودك النادر معنا

خالص تحياتي و تقديري

[محمدي عبد السميع]

ماشاء الله عودة البطل جزاك الله خيرا

تم تعديل يونيو 22, 2010 بواسطه mohammadey1

[عبد الفتاح كيرة]

و الله فعلا

سعدنا بوجود الأخ خبور معنا

أما أنا فتشرفت بوجودك فى أحد موضوعاتى المنقولة

زادك الله علما

[عبدالله باقشير]

السلام عليكم

الله يكرمكم جميعا

انا الذي سعدت بالمشاركة معكم احبائي

حفظكم الله ورعاكم

تقبلوا تحياتي وشكري

خبور خير

[ابو الآء]

بارك الله فيكم جميعا

وتقبل منا ومنكم صالح الاعمال

[ياسر خليل أبو البراء]

مبدع كعادتك أيها العالم الجليل الأخ الحبيب خبور خير

[gamalin]

استاذنا خبور جزاك الله خيرا

كده اتحلت اول مشكلة وهي الحفظ في مسار الملف وهو امر جيد ورائع

يتبقى ان يكون الحفظ للمساحة المظلله من الشيت وليس مشاحة محددة في الكود لصعوبة التعديل بداخل الكود وايضا ليمكن الاستفادة من الميزة دونما فتح الكود للاخرين لتعديل المدى

نشكرك على التواصل وفي انتظار هذا التعديل

[alwjeeh2007]

استاذي العزيز خبور تحية طيبه وبعد

عندي طلب بسيط وهو ان يكون اسم الصورة المحفوظة لخلية معينة مثال الخلية C3 وان يكون مسار الحفظ في مجلد باسم معين

وشكراً

[أكرم الغامدي]

بعد إذن أخي وحبيبي الأستاذ/ خبور خير، فقد أعجبني هذا الطرح وأردت أن أشارك فيه بتلبية طلبات الأخوة الأعزاء.

حدد المدى المطلوب أخذ صورة له ثم انقر الزر "حفظ الصورة" أو قم بالضغط على زر "F5" ثم انقر تشغيل.

سيتم حفظ الصورة في المسار المطلوب وإذا تم التجاهل (أي تم تركه فارغاً) يتم وضع الصورة بجانب البرنامج.

وستكون الصورة باسم الورقة والمدى.

ويمكن أيضاً عمل برنت سكرين للشاشة (Print Screen) ثم تحديد الخيار "من الحافظة مباشرة ً." ثم نقر الزر "حفظ الصورة".

تحياتي للجميع ولصاحب هذا الطرح الجميل.

حفظ صورة من نطاق خلايا معين.rar

تم تعديل يوليو 31, 2010 بواسطه أكرم الغامدي

[عبدالله باقشير]

========================

الاخ الحبيب/ اكرم الغامدي

========================

عمل رائع جداً جداً

سلمت يداك

و

[أبوســـارة1973]

 Dim P

Dim oRange As Range

Dim oCht As Chart

Dim oImg As Picture


P = ActiveWorkbook.Path & "\"


Set oRange = Selection

Set oCht = Charts.Add


Application.ScreenUpdating = False

Application.DisplayAlerts = False

oRange.CopyPicture xlScreen, xlPicture



oCht.Paste


oCht.Export Filename:=P & "SavedRange.jpg", Filtername:="JPG"


oCht.Delete

Application.DisplayAlerts = True

Application.ScreenUpdating = True

End Sub 

وعند التعديل على السطر السادس

ليكون ( Set oRange = selesctin) بدلا من : Set oRange = Range("A1:O35")

يتم حفط أي نطاق يتم تحديده

تم تعديل يوليو 31, 2010 بواسطه abusarah73

[احمد فضيله]

بارك الله فيكم

[أبوســـارة1973]

تعديل الخطأ في كلمة كتبت خطأ( selection) بدلا من ( Selection)

 Dim P

Dim oRange As Range

Dim oCht As Chart

Dim oImg As Picture


P = ActiveWorkbook.Path & "\"


Set oRange = Selection

Set oCht = Charts.Add


Application.ScreenUpdating = False

Application.DisplayAlerts = False

oRange.CopyPicture xlScreen, xlPicture



oCht.Paste


oCht.Export Filename:=P & "SavedRange.jpg", Filtername:="JPG"


oCht.Delete

Application.DisplayAlerts = True

Application.ScreenUpdating = True

End Sub 

وعند التعديل على السطر السادس

ليكون ( Set oRange = Selection) بدلا من : Set oRange = Range("A1:O35")

يتم حفط أي نطاق يتم تحديده

تم تعديل يوليو 31, 2010 بواسطه abusarah73

[أناناس]

السلام عليكم

الرجاء التعديل على الكود 

ليقوم بحفظ نطاق الطباعة المحدد للصفحة

ويسميه بأسم محتوى الخلية A4

ويضعه فى المسار المحدد داخل الكود فى مثلا C\DESKTOP

================================

وهل بالإمكان بدلا من خذف صفحة الشارت جعلها VERYHEDEN فى بداية الكود وأخره لتسريع الكود 

وبارك الله فيكم

 

[أناناس]

للرفع