طلب التعديل على كود لحفظ شيت إكسيل بصيغة PDF إلى سطح المكتب

[علي الشيخ]

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

 

لدي كود يعمل على حفظ صفحة الإكسل التي اعمل عليها Sheet1 مثلا بصيغة PDF

يحفظها هي فقط باسم الملف كله Workbook ولكن المشكلة في انه يحفظها إلى نفس مكان الملف الحالي

المطلوب هو أن يقوم الكود بحفظها إلى سطح المكتب

وإذا هناك إمكانية جعله يقوم بفتح برنامج الأوت لوك وإرفاق ملف البي دي إف الناتج في هذه الرسالة على أن يكون موضوع الرسالة هو نفسه اسم المرفق

وجزاكم الله خيرا

 

والنقطة المهمة هي جعل الحفظ يكون لسطح المكتب

ومرفق الملف

testsavepdf.rar

[ياسر خليل أبو البراء]

جرب الكود بهذا الشكل

Sub Save_as_pdf()
Dim FSO As Object
Dim s(1) As String
Dim sNewFilePath As String

    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    s(0) = "C:\Users\" & Environ("UserName") & "\Desktop\" & ThisWorkbook.Name
    
    If FSO.FileExists(ThisWorkbook.FullName) Then
        '//Change Excel Extension to PDF extension in FilePath
        s(1) = FSO.GetExtensionName(s(0))
        
        If s(1) <> "" Then
            s(1) = "." & s(1)
            sNewFilePath = Replace(s(0), s(1), ".pdf")
            
            '//Export to PDF with new File Path
            ActiveSheet.ExportAsFixedFormat _
                Type:=xlTypePDF, _
                Filename:=sNewFilePath, _
                Quality:=xlQualityStandard, IncludeDocProperties:=True, _
                IgnorePrintAreas:=False, OpenAfterPublish:=True
        End If
    Else
        '//Error: file path not found
        MsgBox "Error: this workbook may be unsaved.  Please save and try again."
    End If
    
    Set FSO = Nothing

End Sub

[علي الشيخ]

شكرا أستاذ ياسر

الله يجزاك الخير ضبطت تمام

[scania]

بعيدا عن الاكواد يوجد برنامج يتم تصطيبه كطابعة make pdf يقوم بحفظ الملف الذى تريد على هيئة pdf 

http://www.dopdf.com/