طلب كود حفظ رينج PDF (تم)

[235Waheed]

Private Sub CommandButton3_Click()
Application.ScreenUpdating = False
Dim ax As VbMsgBoxResult
ax = MsgBox("هل تريد تاكيد الطباعة", vbYesNo + vbQuestion, "طباعة")
If ax = vbYes Then
lr = Sheets(1).Range("a1000").End(xlUp).Row
c = 2
    For I = 3 To lr
        If c Mod 2 = 0 Then
            If Sheets(1).Cells(I, 39) = "موجود" Then
            Sheets(2).Cells(3, 13) = Sheets(1).Cells(I, 1)
            c = c + 1
            End If
            GoTo 1
        Else
            If Sheets(1).Cells(I, 39) = "موجود" Then
            Sheets(2).Cells(29, 13) = Sheets(1).Cells(I, 1)
            c = c + 1
            Sheets(2).Range("a1:P50").PrintOut
            Sheets(2).Cells(3, 13) = ""
            Sheets(2).Cells(29, 13) = ""
            End If
       End If
1:
    Next I
    If Sheets(2).Cells(29, 13) = "" And Sheets(2).Cells(3, 13) <> "" Then
    Sheets(2).Range("a1:P25").PrintOut
    End If
    Else
       
       MsgBox "تم انهاء الطباعة"
       End If
Application.ScreenUpdating = True
End Sub

تم حل الكود بالشكل دا

Private Sub CommandButton3_Click()

 Cells(3, 13) = ""
       Cells(29, 13) = ""
Dim at   As Integer


at = Cells(24, 21).Value
If at = "31" Then

Cells(3, 13) = Cells(20, 20)
       Cells(29, 13) = Cells(20, 23)
       myfile = "F:\elrawy\saarc\" & "(" & Sheets(2).Range("m3").Value & "." & Sheets(2).Range("m29").Value & ")" & Sheets(2).Range("b3").Value & "." & Sheets(2).Range("b29").Value & ".PDF"
     Sheets(2).Range("a1:Q50").ExportAsFixedFormat Type:=xlTypePDF, Filename:=myfile
       If at = "30" Then

Cells(3, 13) = Cells(20, 20)
       Cells(29, 13) = Cells(20, 23)
       Sheets(2).Range("a1:P50").PrintPreview
     
       End If
       End If
     
     Cells(3, 13) = ""
       Cells(29, 13) = ""
       


End Sub

 

تم تعديل نوفمبر 11, 2021 بواسطه 235Waheed

[عبدالفتاح في بي اكسيل]

لم اجرب الكود لكن يظهر  خطا

صحح  هذا  الشي من 

.bdf

الى 

.PDF

 

تم تعديل نوفمبر 11, 2021 بواسطه عبدالفتاح في بي اكسيل