طباعة نتائج البحث في الليست بوكس

[mra63]

السلام عليكم  لدي هذا الكود الذي يقوم بطباعة نتائج البحث في الليست بوكس ويستخدم شيت وسيط لطباعتها ولكن مشكلته انه يقوم بطباعة النتائج في صفحة واحدة مهما كانت كثيرة ويقوم بتصغير الجدول ليجعل الصفحة تستوعب البيانات هل من الممكن تعديل هذا الكود ليطبع علي عدة صفحات . مرفق ملف اكسل .

الشيت الوسيط  -  SHEET3

طباعة نتائج البحث

Dim c As Integer
For r = 0 To ListBox1.ListCount - 1
For c = 1 To ListBox1.ColumnCount - 1
ThisWorkbook.Sheets("Sheet3").Range("A2").Offset(r, c).Value = ListBox1.List(r, c)
Next
Next
Me.Hide
Application.PrintCommunication = False
With Sheets("Sheet3").PageSetup
.FitToPagesWide = 1
.FitToPagesWide = False
End With
Application.PrintCommunication = True
(Dim LastRow As Long
LastRow = ThisWorkbook.Sheets("Sheet3").Range("D100000").End(xlUp).Row
ThisWorkbook.Sheets("Sheet3").Range("A1:D" & LastRow).PrintPreview
Me.Show

MRA63.xlsm

[حسونة حسين]

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

امسح هذه السطور اخى الكريم

Application.PrintCommunication = False
With Sheets("Sheet3").PageSetup
.FitToPagesWide = 1
.FitToPagesWide = False
End With
Application.PrintCommunication = True

 

[mra63]

شكراً علي اهتمامك لكن نفس المشكلة وجربت حذف هذه السطور قبل ان اطرح الموضوع .

[محي الدين ابو البشر]

استبدل

With Sheets("Sheet3").PageSetup
.FitToPagesWide = 1
.FitToPagesWide = False
End With

بـ

With Sheets("Sheet3").PageSetup
.Zoom = 100
End With

 

[mra63]

شكراً استاذنا الفاضل محي الدين ابو البشر بارك الله فيك انحلت المشكلة مع اني اخطأت في نسخ الكود في البداية نسيت المتغير الأول . ادامك الله لنا .

[محي الدين ابو البشر]

بارك الله بك

[mra63]

السلام عيكم - نسيت الاعجاب سامحني ارجوك هذا من حقك عملتوه الآن .