Note: The other languages of the website are Google-translated. Back to English

كيفية حفظ ورقة العمل كملف PDF وإرسالها بالبريد الإلكتروني كمرفق من خلال Outlook؟

في بعض الحالات ، قد تحتاج إلى إرسال ورقة عمل كملف PDF من خلال Outlook. عادة ، يجب عليك حفظ ورقة العمل يدويًا كملف PDF ، ثم إنشاء بريد إلكتروني جديد باستخدام ملف PDF هذا كمرفق في Outlook الخاص بك وإرساله في النهاية. يستغرق تحقيق ذلك يدويًا خطوة بخطوة وقتًا طويلاً. في هذه المقالة ، سنوضح لك كيفية حفظ ورقة العمل بسرعة كملف PDF وإرسالها تلقائيًا كمرفق من خلال Outlook في Excel.

احفظ ورقة العمل كملف PDF وأرسلها بالبريد الإلكتروني كمرفق برمز VBA


احفظ ورقة العمل كملف PDF وأرسلها بالبريد الإلكتروني كمرفق برمز VBA

يمكنك تشغيل رمز VBA أدناه لحفظ ورقة العمل النشطة تلقائيًا كملف PDF ، ثم إرسالها بالبريد الإلكتروني كمرفق من خلال Outlook. الرجاء القيام بما يلي.

1. افتح ورقة العمل التي ستحفظها كملف PDF وأرسلها ، ثم اضغط على قديم + F11 مفاتيح في نفس الوقت لفتح ميكروسوفت فيسوال باسيك للتطبيقات نافذة.

2. في ال ميكروسوفت فيسوال باسيك للتطبيقات الإطار، انقر فوق إدراج > وحدة. ثم انسخ والصق رمز VBA أدناه في ملف رمز نافذة او شباك. انظر لقطة الشاشة:

كود فبا: احفظ ورقة العمل كملف PDF وأرسلها بالبريد الإلكتروني كمرفق

Sub Saveaspdfandsend()
Dim xSht As Worksheet
Dim xFileDlg As FileDialog
Dim xFolder As String
Dim xYesorNo As Integer
Dim xOutlookObj As Object
Dim xEmailObj As Object
Dim xUsedRng As Range

Set xSht = ActiveSheet
Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

If xFileDlg.Show = True Then
   xFolder = xFileDlg.SelectedItems(1)
Else
   MsgBox "You must specify a folder to save the PDF into." & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Must Specify Destination Folder"
   Exit Sub
End If
xFolder = xFolder + "\" + xSht.Name + ".pdf"

'Check if file already exist
If Len(Dir(xFolder)) > 0 Then
    xYesorNo = MsgBox(xFolder & " already exists." & vbCrLf & vbCrLf & "Do you want to overwrite it?", _
                      vbYesNo + vbQuestion, "File Exists")
    On Error Resume Next
    If xYesorNo = vbYes Then
        Kill xFolder
    Else
        MsgBox "if you don't overwrite the existing PDF, I can't continue." _
                    & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Exiting Macro"
        Exit Sub
    End If
    If Err.Number <> 0 Then
        MsgBox "Unable to delete existing file.  Please make sure the file is not open or write protected." _
                    & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Unable to Delete File"
        Exit Sub
    End If
End If

Set xUsedRng = xSht.UsedRange
If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then
    'Save as PDF file 
    xSht.ExportAsFixedFormat Type:=xlTypePDF, Filename:=xFolder, Quality:=xlQualityStandard
    
    'Create Outlook email 
    Set xOutlookObj = CreateObject("Outlook.Application")
    Set xEmailObj = xOutlookObj.CreateItem(0)
    With xEmailObj
        .Display
        .To = ""
        .CC = ""
        .Subject = xSht.Name + ".pdf"
        .Attachments.Add xFolder
        If DisplayEmail = False Then
            '.Send
        End If
    End With
Else
  MsgBox "The active worksheet cannot be blank"
  Exit Sub
End If
End Sub

3. اضغط على F5 مفتاح لتشغيل الكود. في ال تصفح مربع الحوار ، يرجى تحديد مجلد لحفظ ملف PDF هذا ، ثم النقر فوق OK .

ملاحظة:

1. الآن يتم حفظ ورقة العمل النشطة كملف PDF. ويتم تسمية ملف PDF باسم ورقة العمل.
2. إذا كانت ورقة العمل النشطة فارغة ، فستحصل على مربع حوار كما هو موضح أدناه لقطة الشاشة بعد النقر فوق OK .

4. الآن يتم إنشاء بريد إلكتروني جديد في Outlook ويمكنك رؤية ملف PDF مدرجًا كمرفق في الحقل المرفق. انظر لقطة الشاشة:

5. يرجى كتابة هذا البريد الإلكتروني ثم إرساله.
6. يتوفر هذا الرمز فقط عند استخدام Outlook كبرنامج البريد الخاص بك.

احفظ بسهولة ورقة عمل أو أوراق عمل متعددة كملفات PDF منفصلة مرة واحدة:

انقسام وركبوك فائدة كوتولس ل إكسيل يمكن أن تساعدك في حفظ ورقة عمل أو أوراق عمل متعددة بسهولة كملفات PDF منفصلة في وقت واحد كما هو موضح أدناه. قم بتنزيله وجربه الآن! (30- درب مجاني ليوم واحد)


مقالات ذات صلة:


أفضل أدوات إنتاجية المكتب

Kutools for Excel يحل معظم مشاكلك ويزيد إنتاجيتك بنسبة 80٪

  • إعادة استخدام: أدخل بسرعة الصيغ المعقدة والرسوم البيانية وأي شيء استخدمته من قبل ؛ تشفير الخلايا مع كلمة السر إنشاء قائمة بريدية وإرسال رسائل البريد الإلكتروني ...
  • سوبر فورميولا بار (بسهولة تحرير أسطر متعددة من النص والصيغة) ؛ تخطيط القراءة (قراءة وتحرير أعداد كبيرة من الخلايا بسهولة) ؛ لصق في النطاق المصفى
  • دمج الخلايا / الصفوف / الأعمدة دون فقدان البيانات ؛ تقسيم محتوى الخلايا ؛ ادمج الصفوف / الأعمدة المكررة... منع تكرار الخلايا؛ قارن النطاقات
  • حدد مكرر أو فريد صفوف حدد صفوف فارغة (جميع الخلايا فارغة) ؛ البحث الفائق والبحث الغامض في العديد من المصنفات. تحديد عشوائي ...
  • نسخة طبق الأصل خلايا متعددة بدون تغيير مرجع الصيغة ؛ إنشاء المراجع تلقائيًا إلى أوراق متعددة أدخل الرموز النقطية، مربعات الاختيار والمزيد ...
  • استخراج النص، إضافة نص ، إزالة حسب الموضع ، إزالة الفضاء؛ إنشاء وطباعة المجاميع الفرعية لترحيل الصفحات ؛ التحويل بين محتوى الخلايا والتعليقات
  • سوبر تصفية (حفظ وتطبيق مخططات التصفية على أوراق أخرى) ؛ فرز متقدم حسب الشهر / الأسبوع / اليوم ، التكرار والمزيد ؛ مرشح خاص بواسطة bold، italic ...
  • اجمع بين المصنفات وأوراق العمل؛ دمج الجداول على أساس الأعمدة الرئيسية ؛ تقسيم البيانات إلى أوراق متعددة; تحويل دفعة xls و xlsx و PDF
  • أكثر من 300 ميزة قوية. يدعم Office / Excel 2007-2021 و 365. يدعم جميع اللغات. سهولة النشر في مؤسستك أو مؤسستك. الميزات الكاملة نسخة تجريبية مجانية لمدة 30 يومًا. ضمان استرداد الأموال لمدة 60 يومًا.
علامة تبويب kte 201905

يجلب Office Tab الواجهة المبوبة إلى Office ، ويجعل عملك أسهل بكثير

  • تمكين التحرير والقراءة المبوبة في Word و Excel و PowerPointوالناشر والوصول و Visio والمشروع.
  • فتح وإنشاء مستندات متعددة في علامات تبويب جديدة من نفس النافذة ، بدلاً من النوافذ الجديدة.
  • يزيد من إنتاجيتك بنسبة 50٪ ، ويقلل مئات النقرات بالماوس كل يوم!
أوفيسيتاب القاع
فرز التعليقات حسب
التعليقات (63)
تقييم شنومك من شنومكس · تصنيفات 1
تم تصغير هذا التعليق بواسطة المشرف على الموقع
يعمل هذا بشكل رائع بالنسبة لي ولكن هل هناك طريقة لتحديد موقع المجلد تلقائيًا بدلاً من التحديد يدويًا؟ آمل أن أفعل هذا لـ 40 ورقة في وقت واحد.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
كما تأمل في رؤية إجابة لهذه القضية! شكرا للمساعدة!
تم تصغير هذا التعليق بواسطة المشرف على الموقع
لقد حاولت لصق هذا في وحدة نمطية جديدة وحصلت على خطأ في التحويل البرمجي: Sub أو Function غير محددة. الرجاء المساعدة.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
عزيزي دارين ،
ما هو إصدار Office الذي تستخدمه؟
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مكتب 360
تم تصغير هذا التعليق بواسطة المشرف على الموقع
المشكلة نفسها
تم تصغير هذا التعليق بواسطة المشرف على الموقع
كيف يمكنني تحرير برنامج VBA النصي أعلاه بحيث يضيف طابع تاريخ ووقت إلى اسم الملف وبهذه الطريقة لا يستمر في الكتابة فوق ما تم حفظه بالفعل؟
تم تصغير هذا التعليق بواسطة المشرف على الموقع
عزيزي مايكل ،
يرجى تشغيل كود فبا أدناه لحل المشكلة.

Sub Saveaspdfandsend ()
خافت xSht كورقة عمل
خافت xFileDlg كحوار ملف
خافت xFolder كسلسلة
خافت x نعم لا صحيح
تعتيم xOutlookObj ككائن
خافت xEmailObj ككائن
خافت xUsedRng كنطاق
خافت xStr كسلسلة

قم بتعيين xSht = ActiveSheet
قم بتعيين xFileDlg = Application.FileDialog (msoFileDialogFolderPicker)

إذا كان xFileDlg.Show = صحيح إذن
xFolder = xFileDlg.SelectedItems (1)
آخر
MsgBox "يجب تحديد مجلد لحفظ ملف PDF فيه." & vbCrLf & vbCrLf & "اضغط على موافق للخروج من هذا الماكرو." ، vbCritical ، "يجب تحديد مجلد الوجهة"
خروج الفرعية
إنهاء حالة
xStr = تنسيق (الآن () ، "yyyy-mm-dd-hh-mm-ss")
xFolder = xFolder + "\" + xSht.Name + "-" + xStr + ".pdf"

تحقق مما إذا كان الملف موجودًا بالفعل
إذا كان Len (Dir (xFolder))> 0 ثم
xYesorNo = MsgBox (xFolder & "موجود بالفعل." & vbCrLf & vbCrLf & "هل تريد الكتابة فوقه؟"، _
vbYesNo + vbQuestion ، "الملف موجود")
على خطأ استئناف التالي
إذا كان xYesorNo = vbYes ثم
اقتل xFolder
آخر
MsgBox "إذا لم تقم بالكتابة فوق ملف PDF الحالي ، فلا يمكنني المتابعة." _
& vbCrLf & vbCrLf & "اضغط على موافق للخروج من هذا الماكرو." ، vbCritical ، "إنهاء ماكرو"
خروج الفرعية
إنهاء حالة
إذا Err.Number <> 0 ثم
MsgBox "تعذر حذف الملف الموجود. الرجاء التأكد من أن الملف غير مفتوح أو محمي ضد الكتابة." _
& vbCrLf & vbCrLf & "اضغط على" موافق "للخروج من هذا الماكرو." ، vbCritical ، "تعذر حذف الملف"
خروج الفرعية
إنهاء حالة
إنهاء حالة

قم بتعيين xUsedRng = xSht.UsedRange
إذا كان Application.WorksheetFunction.CountA (xUsedRng.Cells) <> 0 ثم
حفظ كملف PDF
xSht.ExportAsFixedFormat Type: = xlTypePDF ، اسم الملف: = xFolder ، الجودة: = xlQualityStandard

إنشاء بريد إلكتروني في Outlook
قم بتعيين xOutlookObj = CreateObject ("Outlook.Application")
قم بتعيين xEmailObj = xOutlookObj.CreateItem (0)
مع xEmailObj
.عرض
. إلى = ""
.CC = ""
.Subject = xSht.Name + "-" + xStr + ".pdf"
المرفقات. إضافة xFolder
إذا كان DisplayEmail = False ثم
'.يرسل
إنهاء حالة
انتهت ب
آخر
MsgBox "لا يمكن أن تكون ورقة العمل النشطة فارغة"
خروج الفرعية
إنهاء حالة
نهاية الفرعية
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا كريستال ،

إنه رائع حقًا ويعمل بشكل مثالي بالنسبة لي. بحاجة إلى مزيد من المساعدة لإضافة:

1. في "إلى" أريد أن أعطي رابطًا لخلية معينة من الورقة النشطة مثل الحكيم في CC وفي BCC ، أود إضافة رابط الورقة النشط
2. في نص البريد الإلكتروني ، أحتاج إلى تحديد بعض النصوص القياسية.

سأكون ممتنًا لك لمساعدتك.

شكر
باراج
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا باراغ سوماني ،
يمكن أن يساعدك رمز VBA أدناه. يُرجى تغيير الحقول .To و .CC و .BCC و. وفقًا لاحتياجاتك.

Sub Saveaspdfandsend ()
خافت xSht كورقة عمل
خافت xFileDlg كحوار ملف
خافت xFolder كسلسلة
خافت x نعم لا صحيح
تعتيم xOutlookObj ككائن
خافت xEmailObj ككائن
خافت xUsedRng كنطاق
خافت xStr كسلسلة

قم بتعيين xSht = ActiveSheet
قم بتعيين xFileDlg = Application.FileDialog (msoFileDialogFolderPicker)

إذا كان xFileDlg.Show = صحيح إذن
xFolder = xFileDlg.SelectedItems (1)
آخر
MsgBox "يجب تحديد مجلد لحفظ ملف PDF فيه." & vbCrLf & vbCrLf & "اضغط على موافق للخروج من هذا الماكرو." ، vbCritical ، "يجب تحديد مجلد الوجهة"
خروج الفرعية
إنهاء حالة
xStr = تنسيق (الآن () ، "yyyy-mm-dd-hh-mm-ss")
xFolder = xFolder + "\" + xSht.Name + "-" + xStr + ".pdf"

تحقق مما إذا كان الملف موجودًا بالفعل
إذا كان Len (Dir (xFolder))> 0 ثم
xYesorNo = MsgBox (xFolder & "موجود بالفعل." & vbCrLf & vbCrLf & "هل تريد الكتابة فوقه؟"، _
vbYesNo + vbQuestion ، "الملف موجود")
على خطأ استئناف التالي
إذا كان xYesorNo = vbYes ثم
اقتل xFolder
آخر
MsgBox "إذا لم تقم بالكتابة فوق ملف PDF الحالي ، فلا يمكنني المتابعة." _
& vbCrLf & vbCrLf & "اضغط على موافق للخروج من هذا الماكرو." ، vbCritical ، "إنهاء ماكرو"
خروج الفرعية
إنهاء حالة
إذا Err.Number <> 0 ثم
MsgBox "تعذر حذف الملف الموجود. الرجاء التأكد من أن الملف غير مفتوح أو محمي ضد الكتابة." _
& vbCrLf & vbCrLf & "اضغط على" موافق "للخروج من هذا الماكرو." ، vbCritical ، "تعذر حذف الملف"
خروج الفرعية
إنهاء حالة
إنهاء حالة

قم بتعيين xUsedRng = xSht.UsedRange
إذا كان Application.WorksheetFunction.CountA (xUsedRng.Cells) <> 0 ثم
حفظ كملف PDF
xSht.ExportAsFixedFormat Type: = xlTypePDF ، اسم الملف: = xFolder ، الجودة: = xlQualityStandard

إنشاء بريد إلكتروني في Outlook
قم بتعيين xOutlookObj = CreateObject ("Outlook.Application")
قم بتعيين xEmailObj = xOutlookObj.CreateItem (0)
مع xEmailObj
.عرض
. إلى = المدى ("A8")
.CC = النطاق ("A9")
.BCC = النطاق ("A10")
.Subject = xSht.Name + "-" + xStr + ".pdf"
. الجسم = "عزيزي" _
& vbNewLine & vbNewLine & _
"هذا بريد إلكتروني تجريبي" & _
"إرسال في Excel"
المرفقات. إضافة xFolder
إذا كان DisplayEmail = False ثم
'.يرسل
إنهاء حالة
انتهت ب
آخر
MsgBox "لا يمكن أن تكون ورقة العمل النشطة فارغة"
خروج الفرعية
إنهاء حالة
نهاية الفرعية
تم تصغير هذا التعليق بواسطة المشرف على الموقع
لقد كنت أحاول استخدام النطاق لـ "To" و "CC" ، فهو لا يلتقط القيم من الخلية المحددة. هل يمكنك المساعدة في هذا؟
شكر،
Mehul
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا كريستال ،

إنه رائع حقًا ويعمل بشكل مثالي بالنسبة لي. بحاجة إلى مزيد من المساعدة لإضافة:

1. في "إلى" أريد أن أعطي رابطًا لخلية معينة من الورقة النشطة مثل الحكيم في CC وفي BCC ، أود إضافة رابط الورقة النشط
2. في نص البريد الإلكتروني ، أحتاج إلى تحديد بعض النصوص القياسية.

سأكون ممتنًا لك لمساعدتك.

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

إنه رائع حقًا ويعمل بشكل مثالي بالنسبة لي. بحاجة إلى مزيد من المساعدة لإضافة:

1. في "إلى" أريد أن أعطي رابطًا لخلية معينة من الورقة النشطة مثل الحكيم في CC وفي BCC ، أود إضافة رابط الورقة النشط
2. في نص البريد الإلكتروني ، أحتاج إلى تحديد بعض النصوص القياسية.

سأكون ممتنًا لك لمساعدتك.

شكر
باراج
تم تصغير هذا التعليق بواسطة المشرف على الموقع
كيف يمكنني إضافة مثال الورقة 2 من المصنف كملف pdf؟
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا ارمين
تحتاج إلى فتح الورقة 2 في المصنف الخاص بك أولاً ثم تشغيل رمز VBA بالخطوات المذكورة أعلاه لتنزيله.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
كيف يمكنني تحرير برنامج VBA النصي أعلاه بحيث يتم حفظ اسم الملف كخلية معينة محددة في الورقة الحالية ، على سبيل المثال الخلية A1؟
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا توم.
آسف لا يمكن أن تساعد في هذا.
مرحبًا بك لنشر أي سؤال في منتدانا: https://www.extendoffice.com/forum.html
ستحصل على المزيد من دعم Excel من محترفي Excel أو غيرهم من محبي Excel.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا ، كيف يمكنني حفظ وإرسال ملف pdf مع اسم المصنف برمز VBA الحالي؟ ماذا أستخدم بدلاً من xSht.Name
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا جيمس،
هل تريد إرسال ورقة العمل النشطة بصيغة pdf وتسميتها باسم المصنف؟
تم تصغير هذا التعليق بواسطة المشرف على الموقع
شكرا انها تعمل.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
كيف يمكنني جعله يحذف ملف pdf المحفوظ بعد إرساله بالبريد الإلكتروني؟
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا جايسون،
آسف لا أستطيع مساعدتك في ذلك حتى الآن. تحتاج إلى حذفه يدويًا بعد إرساله بالبريد الإلكتروني.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا،

هل من الممكن العثور على اسم pdf من خلية؟ السابق. الخلية H4


وفي الخلية H4 أريدها أن تجمع من ثلاث خلايا مختلفة. هل هذا ممكن؟
تم تصغير هذا التعليق بواسطة المشرف على الموقع
هذا ممكن. قم بعمل متغيرات منفصلة للاحتفاظ بالقيمة من الخلايا ثم استخدم تلك المتغيرات عند ضبط xFolder.
لقد استخدمت القيمة من خلية في جريدتي بالإضافة إلى تاريخ اليوم. يمكنك بسهولة عمل قيم خلايا متعددة.

هذا ما أضفته:
خافت xMemberName كسلسلة
خافت xFileDate كسلسلة

xMemberName = النطاق ("H3"). القيمة
xFileDate = تنسيق (الآن ، "mm-dd")

xFolder = xFolder + "\" xMemberName + xFileDate + ".pdf"
تم تصغير هذا التعليق بواسطة المشرف على الموقع
أتلقى خطأ عندما أحاول ذلك ، أين يجب أن أضع هذا في الكود؟
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا كريستال ،



إنه رائع حقًا ويعمل بشكل مثالي بالنسبة لي. بحاجة إلى مزيد من المساعدة لإضافة:

1. في "Body" أريد أن أعطي رابطًا لخلية معينة من الورقة النشطة. علاوة على ذلك أود أن يكون عريض النص.

شكر

التحيات

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

هل تقصد إضافة قيمة الخلية تلقائيًا إلى mailbody وكتابتها بخط عريض؟ لنفترض أنك أضفت قيمة C4 إلى نص البريد. الرجاء تطبيق الكود أدناه.

Sub Saveaspdfandsend ()

خافت xSht كورقة عمل

خافت xFileDlg كحوار ملف

خافت xFolder كسلسلة

خافت x نعم لا صحيح

تعتيم xOutlookObj ككائن

خافت xEmailObj ككائن

خافت xUsedRng كنطاق



قم بتعيين xSht = ActiveSheet

قم بتعيين xFileDlg = Application.FileDialog (msoFileDialogFolderPicker)



إذا كان xFileDlg.Show = صحيح إذن

xFolder = xFileDlg.SelectedItems (1)

آخر

MsgBox "يجب تحديد مجلد لحفظ ملف PDF فيه." & vbCrLf & vbCrLf & "اضغط على موافق للخروج من هذا الماكرو." ، vbCritical ، "يجب تحديد مجلد الوجهة"

خروج الفرعية

إنهاء حالة

xFolder = xFolder + "\" + xSht.Name + ".pdf"



تحقق مما إذا كان الملف موجودًا بالفعل

إذا كان Len (Dir (xFolder))> 0 ثم

xYesorNo = MsgBox (xFolder & "موجود بالفعل." & vbCrLf & vbCrLf & "هل تريد الكتابة فوقه؟"، _

vbYesNo + vbQuestion ، "الملف موجود")

على خطأ استئناف التالي

إذا كان xYesorNo = vbYes ثم

اقتل xFolder

آخر

MsgBox "إذا لم تقم بالكتابة فوق ملف PDF الحالي ، فلا يمكنني المتابعة." _

& vbCrLf & vbCrLf & "اضغط على موافق للخروج من هذا الماكرو." ، vbCritical ، "إنهاء ماكرو"

خروج الفرعية

إنهاء حالة

إذا Err.Number <> 0 ثم

MsgBox "تعذر حذف الملف الموجود. الرجاء التأكد من أن الملف غير مفتوح أو محمي ضد الكتابة." _

& vbCrLf & vbCrLf & "اضغط على" موافق "للخروج من هذا الماكرو." ، vbCritical ، "تعذر حذف الملف"

خروج الفرعية

إنهاء حالة

إنهاء حالة



قم بتعيين xUsedRng = xSht.UsedRange

إذا كان Application.WorksheetFunction.CountA (xUsedRng.Cells) <> 0 ثم

حفظ كملف PDF

xSht.ExportAsFixedFormat Type: = xlTypePDF ، اسم الملف: = xFolder ، الجودة: = xlQualityStandard



إنشاء بريد إلكتروني في Outlook

قم بتعيين xOutlookObj = CreateObject ("Outlook.Application")

قم بتعيين xEmailObj = xOutlookObj.CreateItem (0)

مع xEmailObj

.عرض

. إلى = ""

.CC = ""

.Subject = xSht.Name + ".pdf"

المرفقات. إضافة xFolder

.HTMLBody = "
& Range ("C4") & .HTMLBody

إذا كان DisplayEmail = False ثم

'.يرسل

إنهاء حالة

انتهت ب

آخر

MsgBox "لا يمكن أن تكون ورقة العمل النشطة فارغة"

خروج الفرعية

إنهاء حالة

نهاية الفرعية
تم تصغير هذا التعليق بواسطة المشرف على الموقع
إذا كنت أرغب في الحفظ التلقائي في مجلد معين في كل مرة (مما يلغي حاجة المستخدم إلى اختيار المجلد) ، كيف أفعل ذلك؟
السابق. ج: الفواتير / أمريكا الشمالية / العملاء
المساعدة موضع تقدير كبير.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا جيف ،
هل تقصد حفظ ورقة العمل كملف pdf وحفظها في مجلد معين دون إرسالها؟
تم تصغير هذا التعليق بواسطة المشرف على الموقع
أعتقد أن Geoff يعني القدرة على تحديد مجلد معين في الكود الذي يتم حفظ ملف pdf فيه في كل مرة بدلاً من الاضطرار إلى تحديد الموقع يدويًا. ثم يتم إرسال ملف pdf عبر البريد الإلكتروني من هذا المجلد المحدد.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
شكرا لك جيريمي.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا Geoff ، إذا كنت تريد حفظ ملف pdf تلقائيًا في مجلد معين بدلاً من تحديد الموقع يدويًا ، فيرجى تجربة الكود أدناه. لا تنس تغيير مسار المجلد في الكود.
حفظ فرعي AsPDFandSend ()
خافت xSht كورقة عمل
خافت xFileDlg كحوار ملف
خافت xFolder كسلسلة
خافت x نعم لا صحيح
تعتيم xOutlookObj ككائن
خافت xEmailObj ككائن
خافت xUsedRng كنطاق
خافت xPath كسلسلة
قم بتعيين xSht = ActiveSheet
xPath = "C: \ Users \ Win10x64Test \ Desktop \ Worksheet إلى pdf"هنا" workhet to pdf "هو المجلد الوجهة لحفظ ملفات pdf
xFolder = xPath + "\" + xSht.Name + ".pdf"
إذا كان Len (Dir (xFolder))> 0 ثم
xYesorNo = MsgBox (xFolder & "موجود بالفعل." & vbCrLf & vbCrLf & "هل تريد الكتابة فوقه؟"، _
vbYesNo + vbQuestion ، "الملف موجود")
على خطأ استئناف التالي
إذا كان xYesorNo = vbYes ثم
اقتل xFolder
آخر
MsgBox "إذا لم تقم بالكتابة فوق ملف PDF الحالي ، فلا يمكنني المتابعة." _
& vbCrLf & vbCrLf & "اضغط على موافق للخروج من هذا الماكرو." ، vbCritical ، "إنهاء ماكرو"
خروج الفرعية
إنهاء حالة
إذا Err.Number <> 0 ثم
MsgBox "تعذر حذف الملف الموجود. الرجاء التأكد من أن الملف غير مفتوح أو محمي ضد الكتابة." _
& vbCrLf & vbCrLf & "اضغط على" موافق "للخروج من هذا الماكرو." ، vbCritical ، "تعذر حذف الملف"
خروج الفرعية
إنهاء حالة
إنهاء حالة

قم بتعيين xUsedRng = xSht.UsedRange
إذا كان Application.WorksheetFunction.CountA (xUsedRng.Cells) <> 0 ثم
حفظ كملف PDF
xSht.ExportAsFixedFormat Type: = xlTypePDF ، اسم الملف: = xFolder ، الجودة: = xlQualityStandard

إنشاء بريد إلكتروني في Outlook
قم بتعيين xOutlookObj = CreateObject ("Outlook.Application")
قم بتعيين xEmailObj = xOutlookObj.CreateItem (0)
مع xEmailObj
.عرض
. إلى = ""
.CC = ""
.Subject = xSht.Name + ".pdf"
المرفقات. إضافة xFolder
إذا كان DisplayEmail = False ثم
'.يرسل
إنهاء حالة
انتهت ب
آخر
MsgBox "لا يمكن أن تكون ورقة العمل النشطة فارغة"
خروج الفرعية
إنهاء حالة
نهاية الفرعية
تم تصغير هذا التعليق بواسطة المشرف على الموقع
يعمل هذا الرمز بشكل رائع إلا أنني أريد حفظ ورقة العمل كاسم الورقة + التاريخ (على سبيل المثال ، الورقة 1 أكتوبر 1 2020) ؛ على سطح مكتب المستخدم (سيستخدمه عدة أشخاص وقد تختلف مساراتهم قليلاً). إذا كان ذلك ممكنًا ، فأنا أرغب في تضمين jpg. في النص أيضًا .. يوجد JPG داخل ورقة العمل (خارج منطقة الطباعة) ويتم تخزين الصورة على خادم مشترك .. على الرغم من أن المسار إلى الخادم يختلف حسب مستخدم (بالنسبة لمعظم الأشخاص ، فهو محرك "T" لبعض محركات الأقراص "U")
هل يمكن هذا؟ من فضلك وشكرا مليون مرة.
تم تصغير هذا التعليق بواسطة المشرف على الموقع

مرحبًا ، إنه عمل رائع ، شكرًا لك على المشاركة ، فقط بحاجة إلى مساعدة واحدة.
إذا كنت أرغب في حفظ ملف PDF باسم مخصص (خيار لكتابة اسم الملف في مربع الحوار SaveAs) ، حيث يستخدم المستخدم هذا الخيار في قالب النموذج حيث يتم حفظ النماذج بتنسيق PDF باسم فريد.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا ، يرجى تجربة رمز VBA أدناه. بعد تشغيل الكود ، حدد مجلدًا لحفظ ملف PDF ، ثم سيظهر لك مربع حوار لإدخال اسم الملف. Sub Saveaspdfandsend ()
'تم التحديث بواسطة Extendoffice 20210209
خافت xSht كورقة عمل
خافت xFileDlg كحوار ملف
خافت xFolder كسلسلة
خافت x نعم لا صحيح
تعتيم xOutlookObj ككائن
خافت xEmailObj ككائن
خافت xUsedRng كنطاق
خافت xStrName كسلسلة
خافت xV كمتغير

قم بتعيين xSht = ActiveSheet
قم بتعيين xFileDlg = Application.FileDialog (msoFileDialogFolderPicker)

إذا كان xFileDlg.Show = صحيح إذن
xFolder = xFileDlg.SelectedItems (1)
آخر
MsgBox "يجب تحديد مجلد لحفظ ملف PDF فيه." & vbCrLf & vbCrLf & "اضغط على موافق للخروج من هذا الماكرو." ، vbCritical ، "يجب تحديد مجلد الوجهة"
خروج الفرعية
إنهاء حالة
xStrName = ""
xV = Application.InputBox ("الرجاء إدخال اسم الملف:" ، "Kutools for Excel" ، ، ، ، ، ، 2)
إذا كانت xV = False ثم
خروج الفرعية
إنهاء حالة
xStrName = الخامس عشر
إذا كان xStrName = "" إذًا
MsgBox ("لم يتم إدخال اسم ملف ، إنهاء العملية!")
خروج الفرعية
إنهاء حالة

xFolder = xFolder + "\" + xStrName + ".pdf"
تحقق مما إذا كان الملف موجودًا بالفعل
إذا كان Len (Dir (xFolder))> 0 ثم
xYesorNo = MsgBox (xFolder & "موجود بالفعل." & vbCrLf & vbCrLf & "هل تريد الكتابة فوقه؟"، _
vbYesNo + vbQuestion ، "الملف موجود")
على خطأ استئناف التالي
إذا كان xYesorNo = vbYes ثم
اقتل xFolder
آخر
MsgBox "إذا لم تقم بالكتابة فوق ملف PDF الحالي ، فلا يمكنني المتابعة." _
& vbCrLf & vbCrLf & "اضغط على موافق للخروج من هذا الماكرو." ، vbCritical ، "إنهاء ماكرو"
خروج الفرعية
إنهاء حالة
إذا Err.Number <> 0 ثم
MsgBox "تعذر حذف الملف الموجود. الرجاء التأكد من أن الملف غير مفتوح أو محمي ضد الكتابة." _
& vbCrLf & vbCrLf & "اضغط على" موافق "للخروج من هذا الماكرو." ، vbCritical ، "تعذر حذف الملف"
خروج الفرعية
إنهاء حالة
إنهاء حالة

قم بتعيين xUsedRng = xSht.UsedRange
إذا كان Application.WorksheetFunction.CountA (xUsedRng.Cells) <> 0 ثم
حفظ كملف PDF
xSht.ExportAsFixedFormat Type: = xlTypePDF ، اسم الملف: = xFolder ، الجودة: = xlQualityStandard

إنشاء بريد إلكتروني في Outlook
قم بتعيين xOutlookObj = CreateObject ("Outlook.Application")
قم بتعيين xEmailObj = xOutlookObj.CreateItem (0)
مع xEmailObj
.عرض
. إلى = ""
.CC = ""
.Subject = xSht.Name + ".pdf"
المرفقات. إضافة xFolder
إذا كان DisplayEmail = False ثم
'.يرسل
إنهاء حالة
انتهت ب
آخر
MsgBox "لا يمكن أن تكون ورقة العمل النشطة فارغة"
خروج الفرعية
إنهاء حالة
نهاية الفرعية
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا،
إذا كان لدي ورقتان في الملف ، وأود تشغيل هذا الماكرو على ورقة واحدة (عن طريق الضغط على زر) ولكن أرسل ورقة أخرى ، كيف يمكنني الحصول عليها؟
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا ، أرغب في حفظ هذا في موقع ملف معين ، بالاسم المبني على القيمة الموجودة في الخلية C30 لقد جربت بعض الخيارات ، ولكن استمر في الحصول على أخطاء.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا هاين ، ربما يمكن أن يساعد الكود أدناه. بعد تشغيل الكود ، حدد مجلدًا معينًا لحفظ ملف PDF ، ثم سيظهر لك مربع حوار لإدخال اسم الملف. Sub Saveaspdfandsend ()
'تم التحديث بواسطة Extendoffice 20210209
خافت xSht كورقة عمل
خافت xFileDlg كحوار ملف
خافت xFolder كسلسلة
خافت x نعم لا صحيح
تعتيم xOutlookObj ككائن
خافت xEmailObj ككائن
خافت xUsedRng كنطاق
خافت xStrName كسلسلة
خافت xV كمتغير

قم بتعيين xSht = ActiveSheet
قم بتعيين xFileDlg = Application.FileDialog (msoFileDialogFolderPicker)

إذا كان xFileDlg.Show = صحيح إذن
xFolder = xFileDlg.SelectedItems (1)
آخر
MsgBox "يجب تحديد مجلد لحفظ ملف PDF فيه." & vbCrLf & vbCrLf & "اضغط على موافق للخروج من هذا الماكرو." ، vbCritical ، "يجب تحديد مجلد الوجهة"
خروج الفرعية
إنهاء حالة
xStrName = ""
xV = Application.InputBox ("الرجاء إدخال اسم الملف:" ، "Kutools for Excel" ، ، ، ، ، ، 2)
إذا كانت xV = False ثم
خروج الفرعية
إنهاء حالة
xStrName = الخامس عشر
إذا كان xStrName = "" إذًا
MsgBox ("لم يتم إدخال اسم ملف ، إنهاء العملية!")
خروج الفرعية
إنهاء حالة

xFolder = xFolder + "\" + xStrName + ".pdf"
تحقق مما إذا كان الملف موجودًا بالفعل
إذا كان Len (Dir (xFolder))> 0 ثم
xYesorNo = MsgBox (xFolder & "موجود بالفعل." & vbCrLf & vbCrLf & "هل تريد الكتابة فوقه؟"، _
vbYesNo + vbQuestion ، "الملف موجود")
على خطأ استئناف التالي
إذا كان xYesorNo = vbYes ثم
اقتل xFolder
آخر
MsgBox "إذا لم تقم بالكتابة فوق ملف PDF الحالي ، فلا يمكنني المتابعة." _
& vbCrLf & vbCrLf & "اضغط على موافق للخروج من هذا الماكرو." ، vbCritical ، "إنهاء ماكرو"
خروج الفرعية
إنهاء حالة
إذا Err.Number <> 0 ثم
MsgBox "تعذر حذف الملف الموجود. الرجاء التأكد من أن الملف غير مفتوح أو محمي ضد الكتابة." _
& vbCrLf & vbCrLf & "اضغط على" موافق "للخروج من هذا الماكرو." ، vbCritical ، "تعذر حذف الملف"
خروج الفرعية
إنهاء حالة
إنهاء حالة

قم بتعيين xUsedRng = xSht.UsedRange
إذا كان Application.WorksheetFunction.CountA (xUsedRng.Cells) <> 0 ثم
حفظ كملف PDF
xSht.ExportAsFixedFormat Type: = xlTypePDF ، اسم الملف: = xFolder ، الجودة: = xlQualityStandard

إنشاء بريد إلكتروني في Outlook
قم بتعيين xOutlookObj = CreateObject ("Outlook.Application")
قم بتعيين xEmailObj = xOutlookObj.CreateItem (0)
مع xEmailObj
.عرض
. إلى = ""
.CC = ""
.Subject = xSht.Name + ".pdf"
المرفقات. إضافة xFolder
إذا كان DisplayEmail = False ثم
'.يرسل
إنهاء حالة
انتهت ب
آخر
MsgBox "لا يمكن أن تكون ورقة العمل النشطة فارغة"
خروج الفرعية
إنهاء حالة
نهاية الفرعية
تم تصغير هذا التعليق بواسطة المشرف على الموقع
شكرًا على ذلك ، هذا رائع ، لكني أريد تسمية الورقة وفقًا للخلية A1 في الورقة 1. المكان الذي يجب حفظه وفقًا لـ A1 في الورقة 2 على سبيل المثال C: \ Users \ peete \ Dropbox \ Screenshots ، وإرسال بريد إلكتروني إلى عنوان البريد الإلكتروني على ورقة A3 2 الذي قمت بعمله بالفعل.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
شكرًا على ذلك ، هذا رائع ، لكني أريد تسمية الورقة وفقًا للخلية A1 في الورقة 1. المكان الذي يجب حفظه وفقًا لـ A1 في الورقة 2 على سبيل المثال C: \ Users \ peete \ Dropbox \ Screenshots ، ولكن يمكن تغييره عندما باستخدام الملف ، وإرسال البريد الإلكتروني إلى عنوان البريد الإلكتروني على ورقة A3 2 ، وهو ما قمت به بالفعل.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
Hi كريستال ، رمز ممتاز ، شكرًا للمشاركة. هل هناك طريقة لتحديد أوراق متعددة (من نفس المصنف) لحفظ كل منها كملف PDF مستقل ثم إرسالها جميعًا مرفقة في بريد إلكتروني واحد؟
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا ، يمكن أن يساعدك رمز VBA أدناه ، يرجى المحاولة. في السطر الثاني عشر من الكود ، يرجى استبدال أسماء الأوراق بأسماء الأوراق الفعلية في حالتك.
Sub Saveaspdfandsend1 ()
خافت xSht كورقة عمل
خافت xFileDlg كحوار ملف
خافت xFolder كسلسلة
خافت x نعم لا ، أنا ، xNum كعدد صحيح
تعتيم xOutlookObj ككائن
خافت xEmailObj ككائن
خافت xUsedRng كنطاق
خافت xArrShetts كمتغير
خافت xPDFNameAddress As String
خافت xStr كسلسلة
xArrShetts = صفيف ("اختبار", "الورقة 1", "الورقة 2") 'أدخل أسماء الأوراق التي سترسلها كملفات pdf مرفقة بعلامات اقتباس وافصل بينها بفاصلة. تأكد من عدم وجود أحرف خاصة مثل \ /: "* <> | في اسم الملف.

لأني = 0 إلى UBound (xArrShetts)
على خطأ استئناف التالي
تعيين xSht = Application.ActiveWorkbook.Worksheets (xArrShetts (I))
إذا كان xSht.Name <> xArrShetts (I) ثم
MsgBox "لم يتم العثور على ورقة عمل ، عملية الخروج:" & vbCrLf & vbCrLf & xArrShetts (I)، vbInformation، "Kutools for Excel"
خروج الفرعية
إنهاء حالة
التالى


قم بتعيين xFileDlg = Application.FileDialog (msoFileDialogFolderPicker)
إذا كان xFileDlg.Show = صحيح إذن
xFolder = xFileDlg.SelectedItems (1)
آخر
MsgBox "يجب تحديد مجلد لحفظ ملف PDF فيه." & vbCrLf & vbCrLf & "اضغط على موافق للخروج من هذا الماكرو." ، vbCritical ، "يجب تحديد مجلد الوجهة"
خروج الفرعية
إنهاء حالة
تحقق مما إذا كان الملف موجودًا بالفعل
xYesorNo = MsgBox ("في حالة وجود ملفات الاسم نفسها في المجلد الوجهة ، ستتم إضافة لاحقة الرقم إلى اسم الملف تلقائيًا لتمييز التكرارات" & vbCrLf & vbCrLf & "انقر فوق" نعم "للمتابعة ، انقر فوق" لا "للإلغاء" ، _
vbYesNo + vbQuestion ، "الملف موجود")
إذا كان xYesorNo <> vbYes ثم قم بالخروج من Sub
لأني = 0 إلى UBound (xArrShetts)
تعيين xSht = Application.ActiveWorkbook.Worksheets (xArrShetts (I))

xStr = xFolder & "\" & xSht.Name & ".pdf"
xNum = 1
بينما لا (Dir (xStr ، vbDirectory) = vbNullString)
xStr = xFolder & "\" & xSht.Name & "_" & xNum & ".pdf"
xNum = xNum + 1
وند
قم بتعيين xUsedRng = xSht.UsedRange
إذا كان Application.WorksheetFunction.CountA (xUsedRng.Cells) <> 0 ثم
xSht.ExportAsFixedFormat Type: = xlTypePDF ، اسم الملف: = xStr ، الجودة: = xlQualityStandard
آخر

إنهاء حالة
xArrShetts (I) = xStr
التالى

إنشاء بريد إلكتروني في Outlook
قم بتعيين xOutlookObj = CreateObject ("Outlook.Application")
قم بتعيين xEmailObj = xOutlookObj.CreateItem (0)
مع xEmailObj
.عرض
. إلى = ""
.CC = ""
.Subject = "؟؟؟؟"
لأني = 0 إلى UBound (xArrShetts)
المرفقات. إضافة xArrShetts (I)
التالى
إذا كان DisplayEmail = False ثم
'.يرسل
إنهاء حالة
انتهت ب
نهاية الفرعية
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا ، التغيير الوحيد الذي أواجهه هو إنشاء بريد إلكتروني منفصل لكل مستند pdf تم إنشاؤه.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا ، لإنشاء بريد إلكتروني منفصل لكل مستند pdf ، يمكنك تشغيل VBA يدويًا المتوفر في المنشور في أوراق عمل مختلفة لإنجازه.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
لدي أكثر من 100 ورقة عمل في المصنف ، والتي تستلزم بعد ذلك أنه يتعين علي تشغيل VBA أكثر من 100 مرة ، وهو ما يستغرق وقتًا طويلاً.  
لقد تمكنت من تقسيم كتاب العمل الخاص بي إلى ورقة متعددة ، وبعد ذلك يمكنني تحويل كل ورقة عمل إلى مستند PDF فردي.
الحل الذي أبحث عنه ، هو إرسال كل مستند PDF على حدة بالبريد الإلكتروني أثناء تشغيل العملية المذكورة أعلاه.
طيه VBA الذي أديره حاليًا:
Sub Saveaspdfandsend1 ()
خافت xSht كورقة عمل
خافت xFileDlg كحوار ملف
خافت xFolder كسلسلة
خافت x نعم لا ، أنا ، xNum كعدد صحيح
تعتيم xOutlookObj ككائن
خافت xEmailObj ككائن
خافت xUsedRng كنطاق
خافت xArrShetts كمتغير
خافت xPDFNameAddress As String
خافت xStr كسلسلة
xArrShetts = صفيف ("02302257" ، "02400438" ، "02401829" ، "02403995" ، "02408001" ، "02409208" ، _
"02409980" ، "02411881" ، "02424178" ، "02430454" ، "02444046" ، "02448950" ، "02450600" ، _
"02459861" ، "02461750" ، "02467535" ، "02480484" ، "02484749" ، "02502041" ، "02504807" ، _
"02511843" ، "02515193" ، "02523098" ، "02523244" ، "02524036" ، "02524548" ، "02525516" ، "02525703" ، "02525898" ، "02528908" ، "02528950" ، _
"02530381" ، "02531018" ، "02531252" ، "02531277" ، "02532571" ، "02533053" ، "02533474" ، _
"02534176" ، "02534592" ، "02534626" ، "02535343" ، "02536386" ، "02536921" ، "02537544" ، _
"02537607" ، "02538015" ، "02538755" ، "02538836" ، "02538910" ، "02539685" ، "02540063" ، "02540139" ، "02540158" ، "02541607" ، "02542344" ، _
"02543763" ، "02543985" ، "02544116" ، "02544748" ، "02544762" ، "02545026" ، "02545048" ، _
"02545080" ، "02545447" ، "02545730" ، "02545814" ، "02546477" ، "02547458" ، "02547673" ، _
"02547833" ، "02547912" ، "02547950" ، "02547991" ، "02548848" ، "02549103" ، "02549116" ، "02549125" ، "02549132" ، "02549140" ، "02549182" ، _
"02549462" ، "02549499" ، "02549565" ، "02549687" ، "02550049" ، "02550437" ، "02550812" ، _
"02550982" ، "02551004" ، "02551005" ، "02551045" ، "02552099" ، "02552222" ، "02552561" ، _
"02552684" ، "02552815" ، "02552892" ، "02553031" ، "02553186" ، "02553628" ، "02553721" ، "02555186" ، "02556934" ، "02557137" ، "02557393" ، _
"02559121" ، "02559392" ، "02559419" ، "02559512" ، "02559802" ، "02559868" ، "02560052" ، _
"02560612" ، "02560684" ، "02560920" ، "02561018" ، "02561061" ، "02561092" ، "02561227" ، _
"02561349" ، "02561592" ، "02561630" ، "02561673" ، "02561880" ، "02562359" ، "02562920" ، "02562934" ، "02563013" ، "02563119" ، "02563133" ، _
"02563445" ، "02563737" ، "02563828" ، "02563852" ، "02563861" ، "02563971" ، "02564042" ، _
"02564315"، "02564366"، "02564832"، "02564909"، "02565059"، "02565205") 'أدخل أسماء الأوراق التي سترسلها كملفات pdf مرفقة بعلامات اقتباس وفصل بينها بفاصلة. تأكد من عدم وجود أحرف خاصة مثل \ /: "* <> | في اسم الملف.

لأني = 0 إلى UBound (xArrShetts)
على خطأ استئناف التالي
تعيين xSht = Application.ActiveWorkbook.Worksheets (xArrShetts (I))
إذا كان xSht.Name <> xArrShetts (I) ثم
MsgBox "لم يتم العثور على ورقة عمل ، عملية الخروج:" & vbCrLf & vbCrLf & xArrShetts (I)، vbInformation، "Kutools for Excel"
خروج الفرعية
إنهاء حالة
التالى


قم بتعيين xFileDlg = Application.FileDialog (msoFileDialogFolderPicker)
إذا كان xFileDlg.Show = صحيح إذن
xFolder = xFileDlg.SelectedItems (1)
آخر
MsgBox "يجب تحديد مجلد لحفظ ملف PDF فيه." & vbCrLf & vbCrLf & "اضغط على موافق للخروج من هذا الماكرو." ، vbCritical ، "يجب تحديد مجلد الوجهة"
خروج الفرعية
إنهاء حالة
تحقق مما إذا كان الملف موجودًا بالفعل
xYesorNo = MsgBox ("في حالة وجود ملفات الاسم نفسها في المجلد الوجهة ، ستتم إضافة لاحقة الرقم إلى اسم الملف تلقائيًا لتمييز التكرارات" & vbCrLf & vbCrLf & "انقر فوق" نعم "للمتابعة ، انقر فوق" لا "للإلغاء" ، _
vbYesNo + vbQuestion ، "الملف موجود")
إذا كان xYesorNo <> vbYes ثم قم بالخروج من Sub
لأني = 0 إلى UBound (xArrShetts)
تعيين xSht = Application.ActiveWorkbook.Worksheets (xArrShetts (I))

xStr = xFolder & "\" & xSht.Name & ".pdf"
xNum = 1
بينما لا (Dir (xStr ، vbDirectory) = vbNullString)
xStr = xFolder & "\" & xSht.Name & "_" & xNum & ".pdf"
xNum = xNum + 1
وند
قم بتعيين xUsedRng = xSht.UsedRange
إذا كان Application.WorksheetFunction.CountA (xUsedRng.Cells) <> 0 ثم
xSht.ExportAsFixedFormat Type: = xlTypePDF ، اسم الملف: = xStr ، الجودة: = xlQualityStandard
آخر

إنهاء حالة
xArrShetts (I) = xStr
التالى

إنشاء بريد إلكتروني في Outlook
قم بتعيين xOutlookObj = CreateObject ("Outlook.Application")
قم بتعيين xEmailObj = xOutlookObj.CreateItem (0)
مع xEmailObj
.عرض
. إلى = "Ctracklegal@ctrack.com"
.CC = ""
.Subject = "؟؟؟؟"
لأني = 0 إلى UBound (xArrShetts)
على خطأ استئناف التالي
المرفقات. إضافة xArrShetts (I)
التالى
إذا كان DisplayEmail = False ثم
.إرسال
خروج الفرعية
إنهاء حالة
انتهت ب


نهاية الفرعية
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًاcrystal
هذا فاب - الشيء الرئيسي الذي أواجهه هو اسم الملف - أود سحب اسم الملف من خلية في ورقة العمل بدلاً من استخدام اسم علامة التبويب. لقد قمت بالفعل بتحرير الكود للحفظ تلقائيًا في مجلد محدد ولكني أواجه صعوبة في اسم الملف.
أي مساعدة يمكنك تقديمها من فضلك؟
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا توري ، إذا كنت ترغب في تسمية ملف PDF بقيمة خلية محددة ، يرجى تجربة الكود التالي. بعد تشغيل الكود واختيار مجلد لحفظ الملف ، يظهر مربع حوار آخر ، يرجى تحديد الخلية التي ستستخدمها القيمة كاسم ملف PDF ، ثم انقر فوق موافق للإنهاء.
Sub Saveaspdfandsend2 ()
'تم التحديث بواسطة Extendoffice 20210521
خافت xSht كورقة عمل
خافت xFileDlg كحوار ملف
خافت xFolder كسلسلة
خافت x نعم لا صحيح
تعتيم xOutlookObj ككائن
خافت xEmailObj ككائن
خافت xUsedRng ، xRgInser كنطاق
خافت xB كما منطقية
قم بتعيين xSht = ActiveSheet
قم بتعيين xFileDlg = Application.FileDialog (msoFileDialogFolderPicker)

إذا كان xFileDlg.Show = صحيح إذن
xFolder = xFileDlg.SelectedItems (1)
آخر
MsgBox "يجب تحديد مجلد لحفظ ملف PDF فيه." & vbCrLf & vbCrLf & "اضغط على موافق للخروج من هذا الماكرو." ، vbCritical ، "يجب تحديد مجلد الوجهة"
خروج الفرعية
إنهاء حالة
xB = صحيح
على خطأ استئناف التالي
بينما xB
تعيين xRgInser = لا شيء
تعيين xRgInser = Application.InputBox ("حدد خلية ستستخدم القيمة لتسمية ملف PDF:" ، "Kutools for Excel" ، ، ، ، ، ، 8)
إذا كان xRgInser لا شيء إذن
MsgBox "لم يتم تحديد خلية ، قم بإنهاء العملية!" ، vbInformation ، "Kutools for Excel"
خروج الفرعية
إنهاء حالة
إذا كان xRgInser.Text = "" إذًا
MsgBox "الخلية المحددة فارغة ، يرجى إعادة التحديد!" ، vbInformation ، "Kutools for Excel"
آخر
xB = خطأ
إنهاء حالة
وند

xFolder = xFolder + "\" + xRgInser.Text + ".pdf"

تحقق مما إذا كان الملف موجودًا بالفعل
إذا كان Len (Dir (xFolder))> 0 ثم
xYesorNo = MsgBox (xFolder & "موجود بالفعل." & vbCrLf & vbCrLf & "هل تريد الكتابة فوقه؟"، _
vbYesNo + vbQuestion ، "الملف موجود")
على خطأ استئناف التالي
إذا كان xYesorNo = vbYes ثم
اقتل xFolder
آخر
MsgBox "إذا لم تقم بالكتابة فوق ملف PDF الحالي ، فلا يمكنني المتابعة." _
& vbCrLf & vbCrLf & "اضغط على موافق للخروج من هذا الماكرو." ، vbCritical ، "إنهاء ماكرو"
خروج الفرعية
إنهاء حالة
إذا Err.Number <> 0 ثم
MsgBox "تعذر حذف الملف الموجود. الرجاء التأكد من أن الملف غير مفتوح أو محمي ضد الكتابة." _
& vbCrLf & vbCrLf & "اضغط على" موافق "للخروج من هذا الماكرو." ، vbCritical ، "تعذر حذف الملف"
خروج الفرعية
إنهاء حالة
إنهاء حالة

قم بتعيين xUsedRng = xSht.UsedRange
إذا كان Application.WorksheetFunction.CountA (xUsedRng.Cells) <> 0 ثم
حفظ كملف PDF
xSht.ExportAsFixedFormat Type: = xlTypePDF ، اسم الملف: = xFolder ، الجودة: = xlQualityStandard

إنشاء بريد إلكتروني في Outlook
قم بتعيين xOutlookObj = CreateObject ("Outlook.Application")
قم بتعيين xEmailObj = xOutlookObj.CreateItem (0)
مع xEmailObj
.عرض
. إلى = ""
.CC = ""
.Subject = xSht.Name + ".pdf"
المرفقات. إضافة xFolder
إذا كان DisplayEmail = False ثم
'.يرسل
إنهاء حالة
انتهت ب
آخر
MsgBox "لا يمكن أن تكون ورقة العمل النشطة فارغة"
خروج الفرعية
إنهاء حالة
نهاية الفرعية
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا ، كنت بحاجة إلى شيء مشابه ، لذا ها هو ما حصلت عليه ، فهو يأخذ التاريخ الحالي وينشئ مجلدًا جديدًا باسم التاريخ في موقع معين ، ويضع ملف pdf داخل هذا الموقع الجديد ، ثم يرفق ملف pdf في بريد إلكتروني جديد. يعمل كعلاج. أنا مجرد مبتدئ لذا يرجى المعذرة إذا كانت تبدو وكأنها فوضى. :د
Sub PDFTOEMAIL ()
خافت xSht كورقة عمل
خافت xFileDlg كحوار ملف
خافت xFolder كسلسلة
خافت x نعم لا صحيح
تعتيم xOutlookObj ككائن
خافت xEmailObj ككائن
خافت xUsedRng كنطاق
خافت xPath كسلسلة
خافت xOutMsg كسلسلة
خافت sFolderName كسلسلة ، مجلد كسلسلة
خافت sFolderPath كسلسلة

قم بتعيين xSht = ActiveSheet
xFileDate = تنسيق (الآن ، "dd-mm-yyyy")
sFolder = "C:" هنا هو المكان الذي يوجد فيه مجلد رئيسي
sFolderName = "نهاية الأسبوع" + تنسيق (الآن ، "dd-mm-yyyy") 'المجلد الذي سيتم إنشاؤه في المجلد الرئيسي باسم نهاية الأسبوع والتاريخ الحالي
sFolderPath = "C:" & sFolderName "المجلد الرئيسي مرة أخرى لإنشاء المسار الجديد بما في ذلك المجلد الجديد
تعيين oFSO = CreateObject ("Scripting.FileSystemObject")
إذا كان oFSO.FolderExists (sFolderPath) ثم
MsgBox "المجلد موجود بالفعل!" & vbCrLf & vbCrLf & sFolderPath، vbInformation، "INFO"
آخر
MkDir sFolderPath
MsgBox "تم إنشاء مجلد جديد!" & vbCrLf & vbCrLf & sFolderPath، vbInformation، "INFO"
إنهاء حالة
xPath = sFolderPath
xFolder = xPath + "\" + xSht.Name + "_" + xFileDate + ".pdf"
إذا كان Len (Dir (xFolder))> 0 ثم
xYesorNo = MsgBox (xFolder & "موجود بالفعل." & vbCrLf & vbCrLf & "هل تريد الكتابة فوقه؟"، _
vbYesNo + vbQuestion ، "الملف موجود")
على خطأ استئناف التالي
إذا كان xYesorNo = vbYes ثم
اقتل xFolder
آخر
MsgBox "إذا لم تقم بالكتابة فوق ملف PDF الحالي ، فلا يمكنني المتابعة." _
& vbCrLf & vbCrLf & "اضغط على موافق للخروج من هذا الماكرو." ، vbCritical ، "إنهاء ماكرو"
خروج الفرعية
إنهاء حالة
إذا Err.Number <> 0 ثم
MsgBox "تعذر حذف الملف الموجود. الرجاء التأكد من أن الملف غير مفتوح أو محمي ضد الكتابة." _
& vbCrLf & vbCrLf & "اضغط على" موافق "للخروج من هذا الماكرو." ، vbCritical ، "تعذر حذف الملف"
خروج الفرعية
إنهاء حالة
إنهاء حالة

قم بتعيين xUsedRng = xSht.UsedRange
إذا كان Application.WorksheetFunction.CountA (xUsedRng.Cells) <> 0 ثم
xSht.ExportAsFixedFormat Type: = xlTypePDF ، اسم الملف: = xFolder ، الجودة: = xlQualityStandard
قم بتعيين xOutlookObj = CreateObject ("Outlook.Application")
قم بتعيين xEmailObj = xOutlookObj.CreateItem (0)
xOutMsg = " الرجاء العثور على المرفق تم إنشاء هذا البريد الإلكتروني والمرفق تلقائيًا "
يضيف ملاحظة أنه تم إنشاء البريد الإلكتروني تلقائيًا

مع xEmailObj
.عرض
إلى = "" أضف رسائل البريد الإلكتروني الخاصة بك
.CC = ""
.Subject = xSht.Name + "PDF للأسبوع المنتهي" + xFileDate + "- الموقع" "الموضوع يتضمن اسم الورقة ، pdf ، التاريخ والموقع ، يمكن تعديل هذا حسب الحاجة
المرفقات. إضافة xFolder
.HTMLBody = xOutMsg & .HTMLBody
إذا كان DisplayEmail = False ثم
أرسل <--- هنا إذا حذفت الفاصلة العليا ، فسيتم إرسال البريد الإلكتروني تلقائيًا ، لذا يرجى توخي الحذر
إنهاء حالة
انتهت ب
آخر
MsgBox "لا يمكن أن تكون ورقة العمل النشطة فارغة"
خروج الفرعية
إنهاء حالة
نهاية الفرعية
تم تصغير هذا التعليق بواسطة المشرف على الموقع
كيف يمكنني تحرير هذا الرمز لحفظ الخلايا فقط ("a1: r99") لحفظه بتنسيق PDF. لدي أشياء إضافية على الجوانب لا أريدها في مستند PDF الخاص بي.
Sub Saveaspdfandsend ()
'تم التحديث بواسطة Extendoffice 20210209
خافت xSht كورقة عمل
خافت xFileDlg كحوار ملف
خافت xFolder كسلسلة
خافت x نعم لا صحيح
تعتيم xOutlookObj ككائن
خافت xEmailObj ككائن
خافت xUsedRng كنطاق
خافت xStrName كسلسلة
خافت xV كمتغير

قم بتعيين xSht = ActiveSheet
قم بتعيين xFileDlg = Application.FileDialog (msoFileDialogFolderPicker)

إذا كان xFileDlg.Show = صحيح إذن
xFolder = xFileDlg.SelectedItems (1)
آخر
MsgBox "يجب تحديد مجلد لحفظ ملف PDF فيه." & vbCrLf & vbCrLf & "اضغط على موافق للخروج من هذا الماكرو." ، vbCritical ، "يجب تحديد مجلد الوجهة"
خروج الفرعية
إنهاء حالة
xStrName = ""
xV = Application.InputBox ("الرجاء إدخال اسم الملف:" ، "Kutools for Excel" ، ، ، ، ، ، 2)
إذا كانت xV = False ثم
خروج الفرعية
إنهاء حالة
xStrName = الخامس عشر
إذا كان xStrName = "" إذًا
MsgBox ("لم يتم إدخال اسم ملف ، إنهاء العملية!")
خروج الفرعية
إنهاء حالة

xFolder = xFolder + "\" + xStrName + ".pdf"
تحقق مما إذا كان الملف موجودًا بالفعل
إذا كان Len (Dir (xFolder))> 0 ثم
xYesorNo = MsgBox (xFolder & "موجود بالفعل." & vbCrLf & vbCrLf & "هل تريد الكتابة فوقه؟"، _
vbYesNo + vbQuestion ، "الملف موجود")
على خطأ استئناف التالي
إذا كان xYesorNo = vbYes ثم
اقتل xFolder
آخر
MsgBox "إذا لم تقم بالكتابة فوق ملف PDF الحالي ، فلا يمكنني المتابعة." _
& vbCrLf & vbCrLf & "اضغط على موافق للخروج من هذا الماكرو." ، vbCritical ، "إنهاء ماكرو"
خروج الفرعية
إنهاء حالة
إذا Err.Number <> 0 ثم
MsgBox "تعذر حذف الملف الموجود. الرجاء التأكد من أن الملف غير مفتوح أو محمي ضد الكتابة." _
& vbCrLf & vbCrLf & "اضغط على" موافق "للخروج من هذا الماكرو." ، vbCritical ، "تعذر حذف الملف"
خروج الفرعية
إنهاء حالة
إنهاء حالة

قم بتعيين xUsedRng = xSht.UsedRange
إذا كان Application.WorksheetFunction.CountA (xUsedRng.Cells) <> 0 ثم
حفظ كملف PDF
xSht.ExportAsFixedFormat Type: = xlTypePDF ، اسم الملف: = xFolder ، الجودة: = xlQualityStandard

إنشاء بريد إلكتروني في Outlook
قم بتعيين xOutlookObj = CreateObject ("Outlook.Application")
قم بتعيين xEmailObj = xOutlookObj.CreateItem (0)
مع xEmailObj
.عرض
. إلى = ""
.CC = ""
.Subject = xSht.Name + ".pdf"
المرفقات. إضافة xFolder
إذا كان DisplayEmail = False ثم
'.يرسل
إنهاء حالة
انتهت ب
آخر
MsgBox "لا يمكن أن تكون ورقة العمل النشطة فارغة"
خروج الفرعية
إنهاء حالة
نهاية الفرعية
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا ، لقد جربت للتو هذا الرمز في إحدى أوراق العمل الخاصة بي ولديّ مناطق طباعة محددة بحيث لا تظهر العناصر الإضافية في الأسفل في ملف pdf. جربها!
تم تصغير هذا التعليق بواسطة المشرف على الموقع
Hi
شكرًا جزيلاً على الكود ولكن هل من الممكن حفظ ملف PDF تلقائيًا في نفس الموقع مثل ملف Excel النشط وبنفس اسم الملف مثل ملف Excel النشط؟
شكرا جزيلا.
قضيب
لا توجد تعليقات منشورة هنا حتى الآن
عرض المزيد
اترك تعليقاتك
النشر كضيف
×
قيم المنشور:
0   الشخصيات
المواقع المقترحة

تواصل معنا

حقوق التأليف والنشر © 2009 - شبكة الاتصالات العالمية.extendoffice.com. | كل الحقوق محفوظة. مشغل بواسطة ExtendOffice. | | خريطة الموقع
Microsoft وشعار Office هما علامتان تجاريتان أو علامتان تجاريتان مسجلتان لشركة Microsoft Corporation في الولايات المتحدة و / أو دول أخرى.
محمي بواسطة Sectigo SSL