كود طباعه سريع

[waledms]

السلام عليكم ورحمه الله وبركاته - الأخوة الأعزاء - المطلوب كود للطباعه أسرع من الموجود بالشيت المرفق --- جزاكم الله خيرا

__المقياس المتدرج 3456 الصفوف العليا2027 -.xlsb

[عبدالله بشير عبدالله]

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

جرب الكود المرفق 

Sub PrintFromTo_1()
    Dim adData As Variant
    Dim I As Long
    Dim Rng1 As Range
    Dim printRows As Long
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    
    adData = Range("AD1:AD14").Value
    
    For I = 1 To UBound(adData, 1)
        If Len(adData(I, 1)) > 0 Then
            Cells(1, 13).Value = adData(I, 1)
            
            ActiveSheet.Calculate
            
            printRows = Range("AG1").Value
            
            Set Rng1 = Range("A1").Resize(printRows, 27)
            
            Rng1.PrintOut Copies:=1
        End If
    Next I
    
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

 

[waledms]

الأسماء تظل ثابته ولا تتغير أثناء الطباعه

[عبدالله بشير عبدالله]

نعم صدقت 

اخذف من الكود السابق                  ( بالرغم من اهميته في التسريع)              

    Application.Calculation = xlCalculationManual  من بداية الكود
وكذلك
      Application.Calculation = xlCalculationAutomatic من نهاية الكود                                               

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

[waledms]

الفصول تتغير ولكن مازالت الأسماء ثابته