تعديل كود الطباعة

[بلانك]

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

Test.xlsm

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

السلام عليكم 

جرب التعديل التالي 

Sub sav_PDFall()
    Dim i As Integer
    Dim folderPath As String
    Dim mainSheet As Worksheet
    Dim tempWorkbook As Workbook
    Dim firstRun As Boolean
    Set mainSheet = ThisWorkbook.ActiveSheet
    folderPath = ThisWorkbook.Path & "\ملاحظةالثانوية 2026"
    firstRun = True
    If Dir(folderPath, vbDirectory) = "" Then
        MkDir folderPath
    End If
    Application.ScreenUpdating = False
    For i = 1 To mainSheet.Range("j3").Value
        mainSheet.Range("j2") = i
        If firstRun Then
            mainSheet.Copy
            Set tempWorkbook = ActiveWorkbook
            firstRun = False
        Else
            mainSheet.Copy After:=tempWorkbook.Sheets(tempWorkbook.Sheets.Count)
        End If
    Next i
    tempWorkbook.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=folderPath & "\كشف_جامع_" & mainSheet.Cells(2, 4).Text & ".pdf", _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=True
    tempWorkbook.Close SaveChanges:=False
    Application.ScreenUpdating = True
End Sub

 

[بلانك]

تمام   ................ بارك الله فيك

[بلانك]

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

test2.rar