اذهب الي المحتوي
أوفيسنا

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

قام بنشر (معدل)

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

الكود التالي لحفظ الورقة النشطة على صورة بي دي اف

مع تسمية تعتمد على خليتين في نفس الورقة

مع تاريخ اليوم والزمن

والحفظ في نفس مكان الملف الاصلي

ارجو ان ينال اعحابكم

Sub SaveAsPDF()
    Application.ScreenUpdating = False
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    ThisWorkbook.Path & "\" & ActiveSheet.Name & " " & "Grade " & Range("S1").Value & Range("T1").Value _
    & " " & Format(Now, "mm-dd-yyyy  hh mm' ss'' AM/PM"), Quality _
    :=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False _
    , OpenAfterPublish:=True
    Application.ScreenUpdating = True
End Sub

 

تم تعديل بواسطه علي المصري
قام بنشر
Sub SaveAsPDF()
    Application.ScreenUpdating = False
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    ThisWorkbook.Path & "\" & ActiveSheet.Name & " " & "Grade " & Range("S1").Value & Range("T1").Value _
    & " " & Format(Now, "mm-dd-yyyy  hh mm' ss'' AM/PM"), Quality _
    :=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False _
    , OpenAfterPublish:=True
    Application.ScreenUpdating = True
End Sub

 

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF,

هذا الامر الخاص بتصدير ملف الاكسيل الى ملف بي دي اف

Filename:=

اسم الملف الذي سيكون بعد الحفظ

 _ ThisWorkbook.Path & "\" &

نفس مسار ملف الاكسيل الذي تريد التعامل معه

ActiveSheet.Name

اسم الورقة التي تريد حفظها

& " " & "Grade " & Range("S1").Value & Range("T1").Value _ & " "

خليتين يعتمد عليها التسمية

Grade 12A

Grade 12B

هكذا

& Format(Now, "mm-dd-yyyy hh mm' ss'' AM/PM"),
تنسيق التاريخ والزمن

Quality _ :=xlQualityStandard,

جودة الطباعة

IncludeDocProperties:=True,

خصائص الملف

IgnorePrintAreas:=False _ ,

منطفة الطباعة

OpenAfterPublish:=True

فتح الملف بعد حفظه في صورة بي دي اف

 

 

Book1.rar

قام بنشر

اثراء للموضوع الذي فتحه المحترم الاستاذ علي المصري

Sub SaveAsPDF1()
'=======
    Dim FSO As Object
    Dim S(1) As String
    Dim sNewFilePath As String
    Dim Row As Long
    
    ActiveSheet.Select
    Set FSO = CreateObject("Scripting.FileSystemObject")
    S(0) = ThisWorkbook.FullName
    
    If FSO.FileExists(S(0)) Then
        S(1) = FSO.GetExtensionName(S(0))
        If S(1) <> "" Then
            S(1) = "." & S(1)
            
            sNewFilePath = ThisWorkbook.Path & "\نتيحة.pdf"
            ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sNewFilePath, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
            
        End If
    Else
        MsgBox "لم يتم حفظ الملف ..يوجد خطأ ما "
    End If
    
    ActiveSheet.Select
    Set FSO = Nothing
    
    M = MsgBox("تم التصدير  خارج الشيت بإسم الله اكبر" & vbNewLine & "هذا موجود فى نفس مكان حفظ الملف", vbOKOnly + vbInformation + vbDefaultButton1 + vbApplicationModal + vbMsgBoxRight, "تم التصدير  بصيغة pdf")
End Sub

بارك الله في صاحب هذا الكود .. وكل من كانت له بصمه في عمل الخير

================

 

Book1.rar

قام بنشر
4 hours ago, ناصر سعيد said:

جزاك الله كل خير وبعد:

لم اجد اي تاريخ في صوره البي دي اف  ... اين توجد ؟

التاريخ جزء من اسم الملف الذي تم حفظه

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

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

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

Important Information