طلب : التعديل على كود للمعاينة قبل الطباعة ( مرن )

[حاتم عيسى]

بسم الله الرحمن الرحيم

الأخوة والأساتذة الأفاضل ..  تحية من عند الله ... وبعد

برجاء طلب : التعديل على كود للمعاينة قبل الطباعة حتى اتمكن من عمل المعاينة من على الفورم من أي مكان ومن أي صفحة وتكون المعاينة على الورقة الأولى فقط حتى لو كنت واقف داخل الورقة 2 أو الورقة 3 أو أي مكان ( بمعنى : تحديد ورقة رقم 1 " Sheet1 " لتتم المعاينة على البيانات التي بداخلة فقط ) .

مرفق ملف للعمل علية

وبارك الله فيكم جميعًا ...

معاينة قبل الطباعة عن طريق الفورم.rar

[سليم حاصبيا]

جرب هذا الملف

لادراج الفورم اضغط Ctl+Shift +R في اي صفحة

 

معاينة قبل الطباعة عن طريق الفورم salim.rar

 

[حاتم عيسى]

41 دقائق مضت, سليم حاصبيا said:

جرب هذا الملف

لادراج الفورم اضغط Ctl+Shift +R في اي صفحة

 

معاينة قبل الطباعة عن طريق الفورم salim.rar

 

 

الأستاذ الفاضل المحترم : سليم حاصبيا

بارك الله لك ونفعك بعلمك وزادك من فضله .

هذا ما اطلبه بالضبط .

شكرا لحضرتك

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

هل من الممكن تنفيذ نفس الكود ولكن على الورقة الثانية (تسجيل المتقدمين )  ويكون المدى من A1:S1005

ولسادتكم الشكر .

مرفق الملف للعمل عليه ....

معاينة قبل الطباعة عن طريق الفورم salim.rar

تم تعديل يوليو 1, 2016 بواسطه حاتم عيسى

[سليم حاصبيا]

 Sub Print_Preview_Click()
 Application.ScreenUpdating = False
UserForm1.Hide
Sheets("تسجيل المتقدمين").Activate
ActiveSheet.Cells.Rows.Hidden = False
Lra = ActiveSheet.Cells(Rows.Count, "a").End(3).Row
ActiveSheet.PageSetup.PrintArea = ""

Set my_rg = ActiveSheet.Range("A1:S" & Lra)

With ActiveSheet
         With .PageSetup
           .PrintArea = my_rg.SpecialCells(12).Address
            .PrintTitleRows = "$1:$1"
        End With
 .PrintPreview
End With
 Application.ScreenUpdating = True
End Sub

استبدل الكود بهذا

 

تم تعديل يوليو 1, 2016 بواسطه سليم حاصبيا

[حاتم عيسى]

7 ساعات مضت, سليم حاصبيا said:

 Sub Print_Preview_Click()
 Application.ScreenUpdating = False
UserForm1.Hide
Sheets("تسجيل المتقدمين").Activate
ActiveSheet.Cells.Rows.Hidden = False
Lra = ActiveSheet.Cells(Rows.Count, "a").End(3).Row
ActiveSheet.PageSetup.PrintArea = ""

Set my_rg = ActiveSheet.Range("A1:S" & Lra)

With ActiveSheet
         With .PageSetup
           .PrintArea = my_rg.SpecialCells(12).Address
            .PrintTitleRows = "$1:$1"
        End With
 .PrintPreview
End With
 Application.ScreenUpdating = True
End Sub

استبدل الكود بهذا

 

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