عند الطباعة حفظ كشف حساب على شكل صورة

[أبو أنس حاجب]

السلام عليكم ورحمة الله وبركاته

أساتذتي الكرام حفظكم الله

المطلوب حفظ كشف الحساب في المرفق كصورة بعدد صفحاته المحددة على أن يكون أسم الصورة المحفوظة بنفس أسم العميل الموجود في الخلية P5.

مع الأخذ بعين الأعتبار أن المرفق الأصلي سوف يحتوي على عدد كثير من العملاء

المرفق:

حفظ كشف الحساب على شكل صورة.rar

أبو أنس

[أبو أنس حاجب]

السلام عليكم ورحمة الله وبركاته

للرفع

[أبو أنس حاجب]

السلام عليكم ورحمة الله وبركاته

للرفع

[الـعيدروس]

السلام عليكم

الاخ الحبيب أبو أنس حاجب

جرب هذا الكود

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

Private Const Path_A As String = "C:\Ali\"

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

Public Sub R_pact(Sh As Worksheet, S_Name As String, M_R As Range)

Dim R As Excel.Range

Dim Chrt_A As Excel.ChartObject

With Application

.EnableEvents = False

.ScreenUpdating = False

.DisplayAlerts = False

Set R = M_R

R.CopyPicture xlScreen, xlPicture

Set Chrt_A = ActiveSheet.ChartObjects.Add(0, 0, R.Width + 10, R.Height + 10)

Chrt_A.Chart.Paste

Re_es

Chrt_A.Chart.Export Path_A & S_Name & ".PNG"

Chrt_A.Delete

.EnableEvents = True

.ScreenUpdating = True

.DisplayAlerts = True

End With

Set Chrt_A = Nothing

Set R = Nothing

End Sub

Private Sub Re_es()

On Error Resume Next

With ActiveChart

	 Do Until .SeriesCollection.Count = 0

		 .SeriesCollection(1).Delete

	 Loop

End With

End Sub

استدعاء الكود السطر في كود الاستاذ القدير خبور خير في زر الطباعه عن طريق الفورم

Private Sub ButtonPrint_Click()

Dim wo As Worksheet

Dim Ctrl As Control

Dim I As Integer

'''''''''''''''''

For Each Ctrl In Me.FrameList.Controls

    If Ctrl.Value Then

	    I = I + 1

	    If I = 1 Then Me.Hide

	    Set wo = ActiveWorkbook.Worksheets(CStr(Ctrl.Name))

	    wo.Activate

	    kh_print_out wo

'************************************************************************************

' هذا سطر استدعاء الكود

	    R_pact wo, wo.Name, wo.Range("A5:V" & wo.Cells(Rows.Count, 2).End(xlUp).Row)

'************************************************************************************

    End If

Next

Set wo = Nothing

If I Then Unload Me

End Sub

وهذا ملفك السابق وبه الاكواد

ارجو تجربه الملف

واي ملاحظات او تعديل انا موجود

Sav_Imag_Ali.rar

تم تعديل نوفمبر 24, 2012 بواسطه عباد

[أبو أنس حاجب]

السلام عليكم ورحمة الله وبركاته

أستاذي وسيدي الفاضل أبا نصار حفظكم الله

مجرد ردكم يشعرني بالثقة بـالله ثم بكم بإننا سوف نصل إلى المبتغى بإذن الله.

أرجو أن يتسع صدرك لي وذلك لأني قد لا أستطيع مطابقة الأكواد مع الملف الأصلي لوحدي كي نصل معاً إلى الهدف.

إذاً ماهو المطلوب:

التطبيق على الملف المرفق أدناه لتحقيق التالي:

وهو حفظ كشوفات الحساب المختارة أكان واحداً أو عدة كشوفات أو كل الكشوفات دفعة واحدة وبشكل تلقائي دون توقف إلى آخر حساب تم أختياره وكل حساب يتم حفظه بشكل مستقل على شكل صورة (مع الأخذ بعين الأعتبار أن الكشف الواحد قد يحتوي على عدة صفحات) ويكون أسم الصورة بنفس أسم صاحب الحساب وهذا الأسم سيكون موجود في الخلية P5 لكل صفحات الحسابات المستقلة (أظن أنه من الأفضل بأن يكون من خلال كود مستقل وليس مربوط بكود الطباعة حتى يكون لي حرية الأختيار بين أن اطبع مباشرة على الطابعة أو أن تحفظ الكشوفات على شكل صور كي في المرحلة اللاحقة يتم ارسال الكشوفات بالإيميل وهو سيكون طلب أخر ليس وقته الآن بإرسال الكشوفات المختارة مباشرة إلى إيميل العميل الموجود سلفاً في مكان ما داخل الملف .

ملاحظة الملف بعد إدخال البيانات و عمل نسخة إحتياطية له يتم الضغط على زر False System لإنشاء ملف وهمي متكامل في الهاردسك D من خلاله يتم التعامل مع الملف والتحكم به بالفورم لأستخلاص التقارير والطباعة وماهو مطلوب هنا وغير ذلك بل والعبث به ولن يؤثر ذلك على الملف الأصلي (أعلم أنك سوف تعرف ذلك من خلال ألاكواد ولكن حبيت أختصر الأمر عليك لتعلم كيف يعمل الملف).

أرجو أن أكون أوضحت المطلوب بشكل مناسب.

بارك الله لكم وفيكم وأعانكم على فعل الخيرات ونشر العلم والمعرفة بين المسلمين بل وعامة الناس لأنكم أناس نحسبكم عند الله ذوي نفوس زكية ونبيلة.

المعذرة على الإطالة ولكن حتى أوضح الأمر بدقة لعلي فعلت !؟

المرفق:

Account Statement New Version20(RMB).rar

أبو أنس

[الـعيدروس]

السلام علكم

جرب المرفق

ولاتنسى تحط المسار الصحيح لمجلد حفظ الصور

Private Const Path_A As String = "C:\Intel"

Account Statement New Version20(RMB_2).rar

تم تعديل نوفمبر 25, 2012 بواسطه عباد

[أبو أنس حاجب]

السلام عليكم ورحمة الله وبركاته

أستاذي وسيدي الفاضل أبا نصار حفظكم الله

أولاً أشكر وأقدر لك سرعة التفاعل والرد جزاكم الله كل خير.

سيدي هل جربت استخلاص صور لعدة حسابات في هذا الملف بعد التعديل عليه؟.

لأني لم تظهر لي نتائج وأنما علق الكود أثناء التنفيذ ولم يحقق شئ جربت وضع الفهرس في الـ D والـ C أيضاً وغيرت المسار.

مرة أخرى تقبل فائق التقدير والأحترام والشكر.

أبو أنس

[الـعيدروس]

وعليكم السلام ورحمة الله وبركاته

اخي الفاضل أبو أنس حاجب

جربت الكود عدة مرات يعمل بشكل سليم

ارجو من احد الاخوة تجربة الكود ان كان به مشكله ام لا

تأكد من كتابة المسار بشكل صحيح

تم تعديل نوفمبر 25, 2012 بواسطه عباد

[الـعيدروس]

السلام عليكم

حمل مرفق مشاركة #6 عملت عليه تعديل طفيف

[أبو أنس حاجب]

السلام عليكم ورحمة الله وبركاته

أستاذي وسيدي الفاضل أبا نصار حفظكم الله

عذراً سيدي الفاضل ما أريد أن أسبب لك أي ضيق فلقد جربت عدة مرات وعلى جهاز آخر أيضاً ونفس المشكلة ننتظر أحد الأخوة ممن حملوا الملف لنتأكد أين المشكلة بالضبط إلى ذلك الحين سوف أكون في حالة أنتظار ومحاولات لأن المسألة لدي حيوية ومهمة للغاية في هذا الملف إذا استجد جديد أبلغكم سيدي.

عافاكم الله ويسر لكم أمركم أين ما كنتم.

أبو أنس

[الـعيدروس]

ماهو الاوفيس المستخدم لديك 2003 ام 2007 ؟

[أبو أنس حاجب]

السلام عليكم ورحمة الله وبركاته

أستاذي وسيدي الفاضل أبا نصار حفظكم الله

2003

[الـعيدروس]

ان كان لديك جهاز به 2007

ارجو تجربة الكود به

او من احد الاخوه جزاهم الله خير

[أبو أنس حاجب]

السلام عليكم ورحمة الله وبركاته

أستاذي وسيدي الفاضل أبا نصار حفظكم الله

سيدي لا يوجد لدي جزاكم الله كل خير أن أمكن معالجته كي يعمل على 2003 أكون شديد الأمتنان.

أبو أنس

[الـعيدروس]

السلام عليكم

الاخ الفاضل ابو انس حاجب

ارجو تجربة المرفق تم تغير المسار الى نفس فولدر ملف الاكسل

ربما يكون المشكله في المسار لان الاكواد متوافقه مع 2003

Account Statement.rar

[أبو أنس حاجب]

السلام عليكم ورحمة الله وبركاته

أستاذي وسيدي الفاضل أبا نصار حفظكم الله

سيدي الفاضل كان بودي أن اقول أن كل شئ تمام لثقتي التامة بأنك أكثر مني تحب أن يتم المطلوب.

ولكن أرجو أذا هنالك أحد حمل المرفق وعنده أوفيس 2003 وعمل معه الحدث حتى نستطيع أن نحدد مكمن الخلل.

عندي نفس المشكلة.

تقبل فائق التقدير والأحترام

أبو أنس

[إبراهيم ابوليله]

الاخ ابو انس

يوجد كود مرفق فى الشيت الخاص بك

باسم ccount Statement.

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

ثم يقوم بعمل

PRINT PREVIEW

ارجو تنفيذ ذلك على الشيت المرفق

PRINT.rar

[الـعيدروس]

السلام عليكم

الاخ الفاضل ابراهيم ابو ليله

تفضل الكود ينفذ ماتريد

Sub P_A()

Application.ScreenUpdating = False

With Range("A1:I60000")

  .Select

  .AutoFilter

  .AutoFilter Field:=2, Criteria1:=">""", Operator:=xlAnd

   ActiveSheet.PrintPreview

  .AutoFilter: [A1].Select

End With

Application.ScreenUpdating = True

End Sub

[إبراهيم ابوليله]

الاخ عباد بارك الله فيك

ولكنى اطمع فى اكثر من ذلك

وهو ان يتناسب PRINT PREVIEW

مع المحتوى الذى نريد طباعته دون الحاجه

الى التعديل

فعند الضغط على الزر تجد ان العمود الاخير غير ظاهر بالطباعه

وانا اريد تلافى ذلك

هل يمكن عمل ذلك

PRINT.rar

[الـعيدروس]

السلام عليكم

تفضل

Sub P_A()

Application.ScreenUpdating = False

With ActiveSheet

With .PageSetup

  .Zoom = False

  .FitToPagesWide = 1

  .FitToPagesTall = 1

End With

With .Range("A1:I60000")

  .Select

  .AutoFilter

  .AutoFilter Field:=2, Criteria1:=">""", Operator:=xlAnd

   ActiveSheet.PrintPreview

  .AutoFilter: [A1].Select

End With

End With

Application.ScreenUpdating = True

End Sub

[إبراهيم ابوليله]

الاخ عباد

والله انا مش عارف اققولك ايه

بس فعلا انا اسف على الاطاله

هيا فعلا مشكلة تناسب عرض الوقه كده بقت تمام

ولكن فى حالة كثرة البيانات انا اريد ظهور البيانات وتوزيعها فى الطباعه على اكثر من ورقه

وليس ورقه واحده

مع ملائمة الطابعه لعرض الورقه

والطول يقسم على صفحات

[الـعيدروس]

السلام عليكم

تفضل وعلى الكود شرح مبسط عله يفيدك لتعدل الكود بما يناسب عملك

Sub P_A()

Application.ScreenUpdating = False

With ActiveSheet

With .PageSetup

  .PrintTitleRows = "$1:$1" ' تثبيت عنوان رأس كل صفحة والذي هو أول صف

  .Zoom = False ' تفعيل مربع ملاءمة الصفحة

  .FitToPagesWide = 1 ' 1 = تفعيل ملاءمة عرض الصفحات 0 = عدم تفعيل ملاءمة عرض الصفحات

  .FitToPagesTall = False ' False  = عدم تفعيل ملاءمة الصفحات طولياً True = تفيل ملاءمة طولياَ أي البيانا في ورقة فقط

End With

With .Range("A1:I60000")

  .Select

  .AutoFilter

  .AutoFilter Field:=2, Criteria1:=">""", Operator:=xlAnd

   ActiveSheet.PrintPreview

  .AutoFilter: [A1].Select

End With

End With

Application.ScreenUpdating = True

End Sub

وأي تعدي أو اضافه أنا موجود

و لا عليك أنا في الخدمه طالما الطلب في حدود المعرفه

[a12]

حفظ كشف حساب على شكل صورة ممكن طريقة من غير اكواد

[إبراهيم ابوليله]

اخى الكريم

عباد

والله عمل اكثر من رائع

ولكن هل يمكن ان يظهر اسفل كل صفحه

كلمه صفحه 1 من1

او صفحه 1 من 3

على حسب عدد الصفحت

مع امكانيه التنقل الى الصفحات

[أبو أنس حاجب]

السلام عليكم ورحمة الله وبركاته

أخي الفاضل أبراهيم حفظكم الله

بعد أذن أستاذي وسيدي الفاضل أبا نصار حفظه الله

جرب وضع السطر أدناه

.CenterFooter = "صفحة &P من &N"

وذلك بعد هذا السطر مباشرة.

With .PageSetup

هل هنالك جديد في موضوعي.

أبو أنس