save range from some sheet as PDF

[ِAmerAdnan]

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

عسى أن تكونوا جميعكم بخير ,

أريد لو سمحتوا من ذوي الخبرة في الاكواد , كود لحفظ sheet13.range(a1:j286)pdf ويكون زر التفعيل على صفحة أخرى في Sheet2. ويظهر مباشرة على Desktop

علما بأن pdf محفوظ عندي على C:\ProgramData\Microsoft\Windows

وجزاكم الله عني خيرا,

 

 

[ِAmerAdnan]

شكرا اخي للاجابة السريعة ولكن الملف معقد وكبير شوي , انا إستخدمت كود بفضل هذا الموقع الممتاز . ولكن بقي فقط ان تفعل range ورقم الصفحة مع العلم انني اضفت range

ولكن عند تحويل الملف الى pdf يحول كامل الشيت 

هذا الكود الذي استخدمته من الموقع وكان مفيد

 

 

screen.pdf

[نبيل عبد الهادي]

لم استطع تحميل الملف المرفق 

ضع الكود التالي في  module

الحفظ الافتراضي سيكون في  Desktop بعد اختيار اسم للملف المصدر 

Public Sub Save_Range_As_PDF_On_Desktop()

    Dim fileName As String, saveAsFileName As Variant
    Dim PDFrange As Range
    With Sheets("sheet13")
        Set PDFrange = .Range("a1:j286")
    End With
    saveAsFileName = Application.GetSaveAsFilename(InitialFileName:=Get_SpecialFolderPath("Desktop") & fileName, _
                        FileFilter:="PDF file (*.pdf), *.pdf", _
                        Title:="Save PDF file")
    If saveAsFileName <> False Then
        PDFrange.ExportAsFixedFormat Type:=xlTypePDF, fileName:=saveAsFileName, _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    End If
End Sub
Private Function Get_SpecialFolderPath(SpecialFolderName As Variant) As String
    Get_SpecialFolderPath = CreateObject("WScript.Shell").SpecialFolders(SpecialFolderName) & "\"
End Function

 

[ِAmerAdnan]

الكود يعمل بشكل ممتاز جزاك الله خيرا (أحمد يوسف ) , ممكن تكمل معروفك ويكون حفظ الملف بإسم خلية معينة ويكون الحفظ مباشرة بدون ما يسئل عن مكان الحفظ

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

Sub SHEET_SaveAsPDF()

 Dim Fname As String
 With Worksheets("13")
    Fname = ThisWorkbook.Name & .Range("i4").Value
End With
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, fileName:= _
            "C:\Users\" & Environ("UserName") & "\Desktop\" & Fname, Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
 
End Sub

 

 

[ِAmerAdnan]

جزاك الله خيراً ورزقك الجنة ☘️