تعديل على كود حفظ ملف pdf

[۩◊۩ أبو حنين ۩◊۩]

السلام عليكم

 الساده الافاضل ....

ارجو المساعده فى الكود المرفق ... بعد تقديم الشكر للاخ عبد الله المجرب ... جزاه الله كل الخير على المساعده فى الكود المرفق

 كيف يمكن ضبط الكود على ان يكون التاريخ المضاف لاسم الملف تاريخ اليوم +1 اى تاريخ الغد

وهل يمكن ارسال الملف النتاتج من عمليه الحفظ من خلال نفس الكود اميل عن طريق الاوتلوك

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

Sub PDF_ALL()

 MyName = "D:\MR_" & Format(Date, "dd-mm-yyyy") & ".pdf"

    Range("C45").Select

    Sheets(Array("A", "B", "C", "D")).Select

    Sheets("A").Activate

     MyMsg = MsgBox("هل انت متاكد من اتمام عمليه الحفظ", 4, "تنبيه")

    If MyMsg = 6 Then

    ChDir "D:"

    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _

        MyName, Quality:=xlQualityStandard, _

        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _

        True

    MsgBox "تم الحفظ"

    Else

       MsgBox "لم يتم الحفظ"

        End If

End Sub

 

 

 

 

 

 

 

 

[شوقي ربيع]

هذا ليكون اسم الملف بتاريخ الغد

Sub PDF_ALL()
 MyName = "D:\MR_" & Format(Date + 1, "dd-mm-yyyy") & ".pdf"
 
    Range("C45").Select
    Sheets(Array("A", "B", "C", "D")).Select
    Sheets("A").Activate
     MyMsg = MsgBox("åá ÇäÊ ãÊÇßÏ ãä ÇÊãÇã Úãáíå ÇáÍÝÙ", 4, "ÊäÈíå")
    If MyMsg = 6 Then
    ChDir "D:"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        MyName, Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        True
    MsgBox "Êã ÇáÍÝÙ"
    Else
       MsgBox "áã íÊã ÇáÍÝÙ"
        End If
End Sub

[۩◊۩ أبو حنين ۩◊۩]

اولا  جزاك الله كل الخير على ردك ....

واشكر اخى العزيز عبد الله  لانه الذى اتم الكود بالشكل السابق

ويبقى اخر جزء

وهل يمكن ارسال الملف النتاتج من عمليه الحفظ من خلال نفس الكود اميل عن طريق الاوتلوك

 

جزاك الله خيرا اخى العزيز

واعتزر لك وللجميع فى عدم اختيار اسم الموضوع حسب قواعد المنتدي الذى تم غلقه ( هل من حل لهذه المعضله )

جزاك الله كب الخير

[۩◊۩ أبو حنين ۩◊۩]

للرفع

 

للرفع

 

 

للرفع

[شوقي ربيع]

السلام عليكم

هذا المرفق به الكود السابق من اجل حفظ الملف على شكل PDF في  المسار المدرج في الكود

مع اضافة كود ارسال الملف المحفوظ عبر البريد الالكتروني بواسطة Outlook

فونكسيو استدعاء Outlook

Function OutlMail_PDF(FileNamePDF As String, StrTo As String, StrSubject As String, StrBody As String, Send As Boolean)
    Dim OutApp As Object
    Dim OutMail As Object

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
        .To = StrTo
        .CC = ""
        .BCC = ""
        .Subject = StrSubject
        .Body = StrBody
        .Attachments.Add FileNamePDF
        If Send = True Then
            .Send
        Else
            .Display
        End If
    End With
    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
End Function

وهذا كود الحفظ والارسال معا

Sub PDF_ALL()
    Dim MyName As String

 MyName = "D:\MR_" & Format(Date + 1, "dd-mm-yyyy") & ".pdf"
 
    Range("C45").Select
    Sheets(Array("A", "B", "C", "D")).Select
    Sheets("A").Activate
     MyMsg = MsgBox("هل انت متاكد من اتمام عمليه الحفظ", 4, "تنبيه")
    If MyMsg = 6 Then
    ChDir "D:"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
        MyName, Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        True
        
         OutlMail_PDF MyName, "***@example", "موضوع الرسالة", _
                             vbNewLine & "مع تحيات اخوكم في الله شوقي ربيع", False
    
    Else
       MsgBox "لم يتم الحفظ"
        End If
        
        
End Sub

ملاضة يمكنك ملئ محتوى الرسالة مباشرتا بتعديل عبارة (مع تحيات اخوكم شوقي ربيع) من محرر الاكواد

ارجو ان يكون هذا هو مطلبك

تحياتي للجميع

SavePDF and Send by mail.rar

[أم عبد الله]

أستاذنا الفاضل / شوقي ربيع

 

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

 

جزاك الله خيراً على هذا الكود الرائع. جعل الله جميع أعمالك في ميزان حسناتك. لك كل التحية والتقدير.

[saad abed]

اخى شوقى ربيع

اعمالك مبهره واكوادك سريعه فى الاداء

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

[شوقي ربيع]

السلام عليكم

الاخت الفاضلة  أم عبدالله

والاخ العزيز سعد عابد

لكم مني فائق الاحترام والتقدير

وشكرا جزيلا لعبارتكم الجميلة 

[أسامة عطاالله]

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

Sub hany()
For I = 1 To [e1].Value
[x1].Value = I
ActiveWindow.SelectedSheets.PrintOut copies:=1, collate:=1
Next
End Sub

 شكرا لجهودك اخى الكريم

 

[حمادة عمر]

السلام عليكم

الاخ الحبيب / شوقي ربيع

بارك الله فيك

بالفعل اكواد في منتهي الاتقان والذكاء

وهي بالطبع كعادتك في معظم اكوادك

تقبل خالص تحياتي

[۩◊۩ أبو حنين ۩◊۩]

السلام عليكم

اخى العزيز شوقي ربيع

جزاك الله كل خير ولك منى كل تقدير  على كل ما قدمت انت وجمع الاساده الاعضاء

وإثمارا للموضوع ... واضافه جديد

هل يمكن جعل الحفظ يتم فى وقت محدد سلفاً .... وان كان الملف مغلق

اكر شكرى وتقدرى للجميع .... جزاكم الله كل الخير