اذهب الي المحتوي
أوفيسنا

الردود الموصى بها

قام بنشر

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

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

المطلوب حفظ كشف الحساب في المرفق كصورة بعدد صفحاته المحددة على أن يكون أسم الصورة المحفوظة بنفس أسم العميل الموجود في الخلية 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

تم تعديل بواسطه عباد
قام بنشر

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

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

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

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

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

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

وهو حفظ كشوفات الحساب المختارة أكان واحداً أو عدة كشوفات أو كل الكشوفات دفعة واحدة وبشكل تلقائي دون توقف إلى آخر حساب تم أختياره وكل حساب يتم حفظه بشكل مستقل على شكل صورة (مع الأخذ بعين الأعتبار أن الكشف الواحد قد يحتوي على عدة صفحات) ويكون أسم الصورة بنفس أسم صاحب الحساب وهذا الأسم سيكون موجود في الخلية 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

تم تعديل بواسطه عباد
قام بنشر

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

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

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

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

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

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

أبو أنس

قام بنشر (معدل)

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

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

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

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

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

تم تعديل بواسطه عباد
قام بنشر

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

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

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

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

أبو أنس

قام بنشر

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

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

سيدي لا يوجد لدي جزاكم الله كل خير أن أمكن معالجته كي يعمل على 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

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

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

قام بنشر

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

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

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

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

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

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

With .PageSetup

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

أبو أنس

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • اضف...

Important Information