مشكلة في الطباعة

[amenbkr]

السلام عليكم

لدي ملف ايصالات عند الطباعة  يطبع نفس الايصال مكرر كيف يمكن جعل الطباعة تطبع الارقام المحددة

ايضا هل بمكن انشاء زر يقوم بطباعة الصفحات المحددة بشكل pdf وتكون تسمية الملف المحفوظ هو رقم الاي دي المسجل في الايصال من الاسفل

PTT 2024 .xlsm

[محمد هشام.]

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

Option Explicit
Public Property Get WS() As Worksheet
    Set WS = Sheets("PTT")
End Property
Public Property Get dest() As Worksheet
    Set dest = Sheets("Round 5")
End Property

Private Sub CommandButton1_Click()
Dim r As Long, s As Long, t As Long, tmp As Long, ID As String, n As Boolean
    
    If Trim(TextBox1.Value) = "" Or Trim(TextBox2.Value) = "" Or _
       Not IsNumeric(TextBox1.Value) Or Not IsNumeric(TextBox2.Value) Then
        MsgBox "الرجاء التحقق من أرقام الإيصالات ", vbCritical
        Exit Sub
    End If
    
    s = CLng(TextBox1.Value): t = CLng(TextBox2.Value)
    n = True
    For r = s To t
        tmp = r + 2
        ID = dest.Range("B" & tmp).Value
        If Trim(ID) <> "" Then
            n = False
            Exit For
        End If
    Next r
    
    If n Then
        MsgBox "لا يوجد أي إيصالات للطباعة على قاعدة البيانات ", vbExclamation
        Exit Sub
    End If
    
    On Error Resume Next
    For r = s To t
        tmp = r + 2
        ID = dest.Range("B" & tmp).Value
        
        If Trim(ID) = "" Then GoTo Cnt
        
        WS.[d4] = ID
        WS.[U2] = ID
        
        Err.Clear
        WS.PrintOut
        
        If Err.Number <> 0 Then
            MsgBox "تم إلغاء طباعة الإيصالات", vbExclamation
            Exit Sub
        End If
Cnt:
    Next r
    
    WS.[aa1] = s
    WS.[aa2] = t
    Unload Me
End Sub

'=====================================
Private Sub CommandButton2_Click()
    Dim r As Long, tmp As Long, s As Long, t As Long, FolderName As String
    Dim filePath As String, ID As String, n As Boolean, pdfFolder As String

    If Trim(TextBox1.Value) = "" Or Trim(TextBox2.Value) = "" Or _
       Not IsNumeric(TextBox1.Value) Or Not IsNumeric(TextBox2.Value) Then
        MsgBox "الرجاء التحقق من أرقام الإيصالات ", vbCritical
        Exit Sub
    End If
    
    s = CLng(TextBox1.Value): t = CLng(TextBox2.Value)
    n = True
    For r = s To t
        tmp = r + 2
        ID = dest.Range("B" & tmp).Value
        If Trim(ID) <> "" Then
            n = False
            Exit For
        End If
    Next r
    
    If n Then: MsgBox "لا يوجد أي إيصالات للحفظ على قاعدة البيانات ", vbExclamation: Exit Sub
    
    FolderName = "الإيصالات"
    pdfFolder = ThisWorkbook.Path & "\" & FolderName
    
    If Dir(pdfFolder, vbDirectory) = "" Then
        On Error Resume Next
        MkDir pdfFolder
        If Err.Number <> 0 Then: Exit Sub
        On Error GoTo 0
    End If
    
    For r = s To t
        tmp = r + 2
        
        ID = dest.Range("B" & tmp).Value
        If Trim(ID) = "" Then
            GoTo Cnt
        End If
        
        WS.[d4] = ID: WS.[U2] = ID
        
    filePath = pdfFolder & "\invoice_" & ID & ".pdf"
         WS.ExportAsFixedFormat Type:=xlTypePDF, fileName:=filePath, Quality:=xlQualityStandard, _
         IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
        
Cnt:
    Next r

    MsgBox "تم تصدير الملفات إلى مجلد: " & FolderName, vbInformation
    Unload Me
End Sub

 

PTT 2024 v2.xlsm

[amenbkr]

الف شكر استاذ هشام وجزاك الله خيرا 

سؤال تاني استاذ هشام اثناء حفط الملف بدل كلمة ınvoıce هل يمكن ان يكون اسم المستفيد والذي هو Alıcının
Adı Soyadı العامود c

والف شكر 

[محمد هشام.]

5 ساعات مضت, amenbkr said:

بدل كلمة ınvoıce هل يمكن ان يكون اسم المستفيد والذي هو Alıcının
Adı Soyadı العامود c

نعم أخي يمكنك تعديل السطور الأخيرة من الكود 

Dim fichier As String
' قم بتحديد خلية الإسم بما يناسبك
        fichier = WS.Range("E30").Value
        filePath = pdfFolder & "\" & fichier & ".pdf"
        
        WS.ExportAsFixedFormat Type:=xlTypePDF, fileName:=filePath, Quality:=xlQualityStandard, _
           IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Cnt:
    Next r

    MsgBox "تم تصدير الملفات إلى مجلد: " & FolderName, vbInformation
    Unload Me

وبما أن ورقة Round 5  تتضمن إسم المستفيد على عمود c يمكنك استخدام هدا ليتم تسمية الملف ديناميكيا عند التنفيد مع مزيدا من التحقق 

Private Sub CommandButton2_Click()
    Dim r As Long, s As Long, t As Long, FolderName As String, pdfFolder As String, i As Integer
    Dim filePath As String, ID As String, Item As String, tmp As String, Chars As String

    If Trim(TextBox1.Value) = "" Or Trim(TextBox2.Value) = "" Or _
       Not IsNumeric(TextBox1.Value) Or Not IsNumeric(TextBox2.Value) Then
        MsgBox "الرجاء التحقق من أرقام الإيصالات", vbCritical
        Exit Sub
    End If

    s = CLng(TextBox1.Value): t = CLng(TextBox2.Value)
    
    For r = s To t
        If Trim(dest.Range("B" & r + 2).Value) <> "" Then Exit For
    Next r
    If r > t Then: MsgBox "لا يوجد أي إيصالات للحفظ على قاعدة البيانات", vbExclamation: Exit Sub

    pdfFolder = ThisWorkbook.Path & "\الإيصالات"
    If Dir(pdfFolder, vbDirectory) = "" Then MkDir pdfFolder

    Chars = "\ / : * ? "" < > |"
    For r = s To t
        ID = Trim(dest.Range("B" & r + 2).Value)
        
        '(C)'جلب إسم المستفيد من عمود
        Item = Trim(dest.Range("C" & r + 2).Value)
        
         '(ID)' تجاهل حفظ الملف  عند التحقق من عدم وجود إسم المستفيد أو رقم
        If ID = "" Or Item = "" Then GoTo Cnt

        tmp = Item
        For i = 1 To Len(Chars)
            tmp = Replace(tmp, Mid(Chars, i, 1), "")
        Next i

        filePath = pdfFolder & "\" & tmp & ".pdf"
        
        WS.[d4] = ID: WS.[U2] = ID
        
        On Error Resume Next
        WS.ExportAsFixedFormat Type:=xlTypePDF, fileName:=filePath, Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
        On Error GoTo 0

Cnt:
    Next r

    MsgBox ": تم تصدير الملفات إلى مجلد" & pdfFolder, vbInformation
    Unload Me
End Sub

 

PTT 2024 v3.xlsm

[amenbkr]

الف شكر لستاذ هشام وجزالك الله خيرا