تعديل علي كود حفظ ملف PDF

[ahmed sewelam]

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

شكرا مقدما لخبراءنا بالموقع الغني بالمعلومات القيمة وتجاوبهم السريع 

الرجاء التعديل علي الكود بحيث عند احتيار مسار الفولدر لاي مكان في الكمبيوتر يقوم بحفظ ملف PDFداخل الفولدر 

ملف.xlsm

[Saleh Ahmed Rabie]

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

يمكنك استخدام الكود التالي في VBA لحفظ ملف PDF داخل الفولدر الذي تم اختياره:

Sub SaveAsPDF()
    Dim FilePath As Variant
    Dim FileName As String
    
    ' اختيار مسار الفولدر
    FilePath = Application.GetSaveAsFilename(FileFilter:="PDF Files (*.pdf), *.pdf", Title:="Save As PDF")
    
    ' التأكد من ان تم اختيار مسار الفولدر وليس الالغاء
    If FilePath <> False Then
        ' استخراج اسم الملف من المسار
        FileName = Dir(FilePath)
        
        ' حفظ الورقة الحالية كملف PDF في المسار المحدد
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=FilePath, Quality:=xlQualityStandard
        MsgBox "تم حفظ الملف بنجاح في الفولدر: " & FilePath
    End If
End Sub

```

يقوم هذا الكود بفتح نافذة اختيار مسار الفولدر ويسمح للمستخدم بتحديد مكان حفظ ملف PDF. ثم يقوم بحفظ الورقة الحالية كملف PDF في المسار المحدد. سيتم عرض رسالة تأكيد بعد حفظ الملف بنجاح.

[ahmed sewelam]

ماش شاء الله بارك الله في عمرك مجهود جبار

تعديل اخير هل بالامكان تعديل بالكود بحيث اسم الملف يكون باسم الموظف مباشرة كما بالخلية B8

بدل من ظهور شاشة وكتابة اسم الملف

[Saleh Ahmed Rabie]

13 دقائق مضت, ahmed sewelam said:

ماش شاء الله بارك الله في عمرك مجهود جبار

تعديل اخير هل بالامكان تعديل بالكود بحيث اسم الملف يكون باسم الموظف مباشرة كما بالخلية B8

بدل من ظهور شاشة وكتابة اسم الملف

تأكد ان يكون لكل مستخدم اسمه محفوظ في الـ cell B8 ، فهذا الاسم سيتم حفظه مع الملف الـ PDF ككود. يجب تغيير السطر التالي:

FileName = Dir(FilePath)

 

إلى:

FileName = Range("B8").Value

هذا الكود سيجعل اسم الملف الـ PDF يأخذ قيمة الـ cell B8 مباشرة كاسم للموظف.

تم تعديل يونيو 10 بواسطه Saleh Ahmed Rabie

[ahmed sewelam]

للاسف لم يقم الكود بعمل المطلوب حيث تم تغيير الكود لكن تظهر شاشة ادخال اسم الملف والمطلوب انه يحفظ تلقائي الملف باسم الموظف كما بالخلية B8 داخل الفولدر

[Saleh Ahmed Rabie]

38 دقائق مضت, ahmed sewelam said:

للاسف لم يقم الكود بعمل المطلوب حيث تم تغيير الكود لكن تظهر شاشة ادخال اسم الملف والمطلوب انه يحفظ تلقائي الملف باسم الموظف كما بالخلية B8 داخل الفولدر

 

ملف3.xls ملف2.xlsm

[محمد هشام.]

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

تفضل اخي جرب هدا 

Private Sub CommandButton1_Click()
Dim WS As Worksheet: Set WS = Sheet3
Dim FileName As String, strDirname As String, Patch As String, strDefpath As String
  strDirname = Me.TextBox1.Text
  FileName = WS.[B8]
  strDefpath = Label2.Caption
  lr = WS.Range("B" & WS.Rows.Count).End(xlUp).Row
  WS.PageSetup.PrintArea = "A1:D" & lr + 5
  On Error Resume Next
  If FileName = "" Then MsgBox "يرجى اظافة اسم الملف":   Exit Sub
  If Not Right(strDefpath, 1) = "\" Then strDefpath = strDefpath & "\"
  If Not Right(FileName, 4) = ".Pdf" Then FileName = FileName & ".Pdf"
  If Dir(strDefpath & strDirname, vbDirectory) = "" Then MkDir strDefpath & strDirname
  Patch = strDefpath & strDirname & "\" & FileName
  WS.ExportAsFixedFormat Type:=xlTypePDF, FileName:=Patch
End Sub

 

ملف V2.xlsm

[ahmed sewelam]

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

[محمد هشام.]

في حالة الرغبة باستخدام الكود الخاص بك يكفي تعديله  فقط على الشكل التالي 

Sub PDF()
Dim Path As String
Path = Label2.Caption

'Code.........................

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
          Path & "ملف رواتب الموظفين\" & fName, Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

End Sub

 

[Saleh Ahmed Rabie]

3 دقائق مضت, ahmed sewelam said:

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