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

[عمار محمد حسن]

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

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

 

ولكم مني كل الشكر والاحترام

استعلام.rar

[شوقي ربيع]

السلام عليكم

استخدم هذا الكود

Private Sub CommandButton2_Click()
    Dim Tableau() As Variant: Tableau() = ListBox1.List
    Dim I As Integer: I = ListBox1.ListCount
    Dim J As Byte: J = ListBox1.ColumnCount
    Application.DisplayAlerts = False
        Workbooks.Add
        Range("A1:" & Cells(I, J).Address) = Tableau()
        Me.Hide
        ActiveWindow.SelectedSheets.PrintPreview
        ActiveWorkbook.Close False
    Application.DisplayAlerts = True
       Me.show
End Sub

[عمار محمد حسن]

 

السلام عليكم

استخدم هذا الكود

Private Sub CommandButton2_Click()
    Dim Tableau() As Variant: Tableau() = ListBox1.List
    Dim I As Integer: I = ListBox1.ListCount
    Dim J As Byte: J = ListBox1.ColumnCount
    Application.DisplayAlerts = False
        Workbooks.Add
        Range("A1:" & Cells(I, J).Address) = Tableau()
        Me.Hide
        ActiveWindow.SelectedSheets.PrintPreview
        ActiveWorkbook.Close False
    Application.DisplayAlerts = True
       Me.show
End Sub

بارك الله فيك اخي شوقي ربيع وجعل الله اعمالك في ميزان حسناتك

لو سمحت استاذي شرح ولو بسيط لهذا الكود وكذالك عند المعاينة كيف يمكنني تنسيق الصفحه

كل الشكر والاحترام والتقدير لك

[شوقي ربيع]

الامر بسيط

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

[عمار محمد حسن]

الامر بسيط

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

تمام استاذي الكريم وصلت الفكره ولكن السؤل كيف يمكنني عمل التنسيق لان في صفحه المعاينة المعلومات غير مرتبه

[شوقي ربيع]

يمكن ذلك بتجهيز شيت منسق في الملف نفسه

وجع الكود ييرحل بينات اليست الى ذلك الشيت بدلا من انشاء ملف جديد مثل الاول

[عمار محمد حسن]

يمكن ذلك بتجهيز شيت منسق في الملف نفسه

وجع الكود ييرحل بينات اليست الى ذلك الشيت بدلا من انشاء ملف جديد مثل الاول

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

[شوقي ربيع]

لا عليك اخي

انما احبد ان يعتمد الاعضاء على انفسهم ليتعلمو

بعد عملك لشيت وضبط تنسيقاته استخدم هذا الكود بدل الكود الاول

Private Sub CommandButton2_Click()
    Dim ws As Worksheet: Set ws = Sheets("هنا اكتب اسم الشيت المنسق")
    Dim Tableau() As Variant: Tableau() = ListBox1.List
    Dim I As Integer: I = ListBox1.ListCount
    Dim J As Byte: J = ListBox1.ColumnCount
    Application.DisplayAlerts = False
        ws.Range("A1:" & Cells(I, J).Address) = Tableau()
        Me.Hide
        ActiveWindow.SelectedSheets.PrintPreview
    Application.DisplayAlerts = True
       Me.Show
End Sub

[عمار محمد حسن]

 

لا عليك اخي

انما احبد ان يعتمد الاعضاء على انفسهم ليتعلمو

بعد عملك لشيت وضبط تنسيقاته استخدم هذا الكود بدل الكود الاول

Private Sub CommandButton2_Click()
    Dim ws As Worksheet: Set ws = Sheets("هنا اكتب اسم الشيت المنسق")
    Dim Tableau() As Variant: Tableau() = ListBox1.List
    Dim I As Integer: I = ListBox1.ListCount
    Dim J As Byte: J = ListBox1.ColumnCount
    Application.DisplayAlerts = False
        ws.Range("A1:" & Cells(I, J).Address) = Tableau()
        Me.Hide
        ActiveWindow.SelectedSheets.PrintPreview
    Application.DisplayAlerts = True
       Me.Show
End Sub

استاذ ربيع في صفحه انتقال نتائج اللست بوكس يعطي نفس النتائج المستعلم عنها بالضبط ولكن في صفحه المعاينه يظهر كل البيانات بدون تصفيه لا ادري ما السبب.

[شوقي ربيع]

لم افهم السؤال الاخير

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

[عمار محمد حسن]

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

استعلام2.rar

[شوقي ربيع]

OK

الخطاء كان ان المعاينة تكون لشيت المتاكتف و هو شيت الداتا

الكود صبح

  Dim ws As Worksheet: Set ws = Sheets("æÑÞÉ2")
    Dim Tableau() As Variant: Tableau() = ListBox1.List
    Dim I As Integer: I = ListBox1.ListCount
    Dim J As Byte: J = ListBox1.ColumnCount
    Application.DisplayAlerts = False
        ws.Range("A3:" & Cells(I, J).Address).Value = Tableau()
        Me.Hide
        ws.PrintPreview
    Application.DisplayAlerts = True
       Me.show

استعلام2.rar

[عمار محمد حسن]

 

OK

الخطاء كان ان المعاينة تكون لشيت المتاكتف و هو شيت الداتا

الكود صبح

  Dim ws As Worksheet: Set ws = Sheets("æÑÞÉ2")
    Dim Tableau() As Variant: Tableau() = ListBox1.List
    Dim I As Integer: I = ListBox1.ListCount
    Dim J As Byte: J = ListBox1.ColumnCount
    Application.DisplayAlerts = False
        ws.Range("A3:" & Cells(I, J).Address).Value = Tableau()
        Me.Hide
        ws.PrintPreview
    Application.DisplayAlerts = True
       Me.show

اخي الاستاذ ربيع جرب عمليه الاستعلام في الملف 01/01/2015 الى 01/01/2015 مثلا وشاهد نتائج المعاينة المعلومات غير كامله بالمعاينة

[شوقي ربيع]

صحيح

صقطت مني سهوا

لم اضع كود يمحى البيانات الموجود سابقا

انضر هدا واعلمني

  Dim ws As Worksheet: Set ws = Sheets("æÑÞÉ2")
    Dim Tableau() As Variant: Tableau() = ListBox1.List
    Dim I As Integer: I = ListBox1.ListCount + 2
    Dim J As Byte: J = ListBox1.ColumnCount
    Application.DisplayAlerts = False
        ws.Range("A3:G3" & Range("A3").End(xlDown)).ClearContents
        ws.Range("A3:" & Cells(I, J).Address).Value = Tableau()
        Me.Hide
        ws.PrintPreview
    Application.DisplayAlerts = True
       Me.show

[عمار محمد حسن]

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

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

 

كل الاحترام والتقدير لشخصك الكريم