اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

الردود الموصى بها

  • تمت الإجابة
قام بنشر (معدل)

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

جرب هدا

حفظ الملفات في تفس مسار الملف 

Option Explicit
Sub SAVE_PDF()
    Dim ScWS As Variant, Path As String, i As Integer
    ScWS = Array("Sheet1", "Sheet2", "Sheet3")
    Path = ThisWorkbook.Path & "\"

    If Path = "\" Then Exit Sub
    For i = LBound(ScWS) To UBound(ScWS)
        If Not ShExists(ScWS(i)) Then MsgBox "الورقة " & ScWS(i) & " غير موجودة": Exit Sub
        Application.ScreenUpdating = False
        On Error Resume Next
        Sheets(ScWS(i)).ExportAsFixedFormat Type:=xlTypePDF, FileName:=Path & ScWS(i) & ".pdf", _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
        On Error GoTo 0
    Next i
    Application.ScreenUpdating = True
    MsgBox "تم حفظ الملفات بنجاح"
End Sub

لإنشاء مجلد وحفظ الملفات بداخله

Sub SAVE_PDF_Folder()
    Dim ScWS As Variant, Path As String, Dossier As String, i As Integer
    ScWS = Array("Sheet1", "Sheet2", "Sheet3")
    Path = ThisWorkbook.Path & "\"
    Dossier = "ملفات PDF"

    If Path = "\" Then Exit Sub
    If Dir(Path & Dossier, vbDirectory) = "" Then MkDir Path & Dossier
    
    Path = Path & Dossier & "\"
    For i = LBound(ScWS) To UBound(ScWS)
        If Not ShExists(ScWS(i)) Then MsgBox "الورقة " & ScWS(i) & " غير موجودة": Exit Sub
        Application.ScreenUpdating = False
        On Error Resume Next
        Sheets(ScWS(i)).ExportAsFixedFormat Type:=xlTypePDF, FileName:=Path & ScWS(i) & ".pdf", _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
        On Error GoTo 0
    Next i
    Application.ScreenUpdating = True
    MsgBox "تم حفظ الملفات بنجاح"
End Sub
Function ShExists(ByVal SheetName As String) As Boolean
    On Error Resume Next: ShExists = Not Sheets(SheetName) Is Nothing: On Error GoTo 0
End Function

 

 

حفظ الملفات مستقلة بصيغة PDF.xlsb

تم تعديل بواسطه محمد هشام.
  • Like 2

انشئ حساب جديد او قم بتسجيل دخولك لتتمكن من اضافه تعليق جديد

يجب ان تكون عضوا لدينا لتتمكن من التعليق

انشئ حساب جديد

سجل حسابك الجديد لدينا في الموقع بمنتهي السهوله .

سجل حساب جديد

تسجيل دخول

هل تمتلك حساب بالفعل ؟ سجل دخولك من هنا.

سجل دخولك الان
  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information