ممكن شرح كود طباعة للاستاذ ضاحى الغريب

[احمد عبدة]

ارجو من استاذنا الفاضل / ضاحى الغريب شرح كود الطباعة لبرنامج الايجارات 
لقلة معرفتى بكود الطباعة 
 
تحياتى لاستاذنا الغالى

 

[Sub Tenants_LstAdaMPrint()

Set Frm = Tenants

Sheet6.Visible = True

Set SH = Sheet6

Application.Visible = True

With SH

.Activate

 

For mm = 0 To Frm.LstAdaM.ListCount

Dim Last As Long

Rows("5:5").Hidden = False

Last = Range("b" & Rows.Count).End(xlUp).Row + 1 + mm

On Error Resume Next

With Rows(Last)

    .FillDown

    .SpecialCells(xlConstants).ClearContents

End With

 

On Error GoTo 0

Next

 

 

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

LsRow = .Cells(Rows.Count, "b").End(xlUp).Row + 1

On Error Resume Next

For AA = 0 To Frm.LstAdaM.ListCount

.Cells(AA + LsRow, 2) = Frm.LstAdaM.Column(5, AA)

.Cells(AA + LsRow, 4) = Frm.LstAdaM.Column(3, AA)

.Cells(AA + LsRow, 5) = Frm.LstAdaM.Column(1, AA)

 

Next:

'"""""""""""""""""""""""""""""""""""""""""""""""""""""""

LR = .Cells(Rows.Count, "b").End(xlUp).Row

.Cells(LR + 1, 5) = Frm.T_Total1.Value: .Cells(LR + 1, 2) = "الـمجمـوع "

'.Cells(LR + 1, 6) = Frm.Paid.Value

'.Cells(LR + 1, 7) = Frm.T_Total1.Value

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

Rows("5:5").Hidden = True

 ER = WorksheetFunction.CountA(Range("A:E")) + 1

 RR = .Cells(.Rows.Count, "A").End(xlUp).Row

 RN = "A1:E" & ER

 .[A3].Value = Frm.Lb_Information.Caption

 

                                                                                   Tenants.Hide

    .Range(RN).PrintOut Copies:=1, Preview:=True, Collate:=True

    

   .Range("A6:E" & Rows.Count).Clear:  .[A3].Value = ""

   Sheet6.Visible = False

   Sheet1.Activate

   Application.Visible = False

  Tenants.Show

End With:  End Sub

تم تعديل نوفمبر 16, 2014 بواسطه احمد عبدة

[الصـقر]

اخى الكريم 

ممكن ترفق الملف اللى فيه الكود 

[احمد عبدة]

الملف عبارة عن برنامج الايجارات للاستاذ ضاحى الغريب

 

بعد اذن الاستاذ ضاحى الغريب

 

 

 

برنامج الايجارات الاصدار الثاني - ضاحي الغريب.rar

[ضاحي الغريب]

تفضل شرح الكود
الكود مقسم الي نسخ التنسيق وترحيل البيانات من الليست ثم معاينتها تمهيدا لطباعتها
Sub Tenants_LstAdaMPrint()
Set Frm = Tenants
'اظهار الشيت المخصصص لفورم الطباعة
Sheet6.Visible = True
Set SH = Sheet6
'اظهار تطبيق
Application.Visible = True
With SH
.Activate

For mm = 0 To Frm.LstAdaM.ListCount
'الجزء التالي مسئول عن نسخ التنسيق من الصف الخامس لبقية الصفوف حسب صفوف الليست بوكس
Dim Last As Long
'اظهار الصف الخامس
Rows("5:5").Hidden = False
'نسخ التنسيق بما يساوي صفوف االليست بوكس
Last = Range("b" & Rows.Count).End(xlUp).Row + 1 + mm
On Error Resume Next
With Rows(Last)
    .FillDown
    .SpecialCells(xlConstants).ClearContents
End With

On Error GoTo 0
Next

 'هذا الجزء خاص بترحيل البيانات من الليست بوكس الي الشيت
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
LsRow = .Cells(Rows.Count, "b").End(xlUp).Row + 1
On Error Resume Next
For AA = 0 To Frm.LstAdaM.ListCount
.Cells(AA + LsRow, 2) = Frm.LstAdaM.Column(5, AA)
.Cells(AA + LsRow, 4) = Frm.LstAdaM.Column(3, AA)
.Cells(AA + LsRow, 5) = Frm.LstAdaM.Column(1, AA)

Next:
'"""""""""""""""""""""""""""""""""""""""""""""""""""""""
'بعد الانتهاء من ترحيل صفوف الليست بوكس اضافة سطر المجموع
LR = .Cells(Rows.Count, "b").End(xlUp).Row
.Cells(LR + 1, 5) = Frm.T_Total1.Value: .Cells(LR + 1, 2) = "الـمجمـوع "
'.Cells(LR + 1, 6) = Frm.Paid.Value
'.Cells(LR + 1, 7) = Frm.T_Total1.Value
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'اخفاء الصف الخامس
Rows("5:5").Hidden = True
'تحديد مدي الطباعة
 ER = WorksheetFunction.CountA(Range("A:E")) + 1
 RR = .Cells(.Rows.Count, "A").End(xlUp).Row
 RN = "A1:E" & ER
 'تحديد عنوان التقرير
 .[A3].Value = Frm.Lb_Information.Caption

                                                                                   Tenants.Hide 'اخفاء الفورم
    .Range(RN).PrintOut Copies:=1, Preview:=True, Collate:=True 'تنفيذ عملية المعينة تمهيد الطباعة
    
   .Range("A6:E" & Rows.Count).Clear:  .[A3].Value = "" 'مسح البيانات من الشيت
   Sheet6.Visible = False 'اخفاء الشيت
   Sheet1.Activate
   Application.Visible = False 'اخفاء التطبيق
  Tenants.Show 'اظهار الفورم بعد الانتهاء من الطباعة
End With:  End Sub

[احمد عبدة]

جزاك الله خيرا استاذنا الكبير ضاحى

بارك الله فيك وذادك من علمة