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

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

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

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

رائعة حقا! استخدام علامات تبويب فعالة في Excel مثل Chrome و Firefox و Safari!

وفر 50٪ من وقتك ، وقلل آلاف النقرات بالماوس كل يوم!

يمكنك تشغيل رمز 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 منفصلة في وقت واحد كما هو موضح أدناه. قم بتنزيله وجربه الآن! (30- درب مجاني ليوم واحد)

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

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

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

اقرأ أكثر... تحميل مجاني ... شراء...

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

تمكين التحرير والقراءة المبوبة في Word و Excel و PowerPointوالناشر والوصول و Visio والمشروع.
فتح وإنشاء مستندات متعددة في علامات تبويب جديدة من نفس النافذة ، بدلاً من النوافذ الجديدة.
يزيد من إنتاجيتك بنسبة 50٪ ، ويقلل مئات النقرات بالماوس كل يوم!

اقرأ أكثر... تحميل مجاني ... شراء...

التعليقات (63)

تقييم شنومك من شنومكس · تصنيفات 1

مايكل

منذ حوالي 5 سنوات

#20277

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

يعمل هذا بشكل رائع بالنسبة لي ولكن هل هناك طريقة لتحديد موقع المجلد تلقائيًا بدلاً من التحديد يدويًا؟ آمل أن أفعل هذا لـ 40 ورقة في وقت واحد.

رد

هيو مايكل

منذ حوالي 2 سنوات

#20278

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

كما تأمل في رؤية إجابة لهذه القضية! شكرا للمساعدة!

رد

دارين

منذ حوالي 5 سنوات

#22279

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

لقد حاولت لصق هذا في وحدة نمطية جديدة وحصلت على خطأ في التحويل البرمجي: Sub أو Function غير محددة. الرجاء المساعدة.

رد

كريستال دارين

منذ حوالي 5 سنوات

#22280

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

عزيزي دارين ،
ما هو إصدار Office الذي تستخدمه؟

رد

بلغ

ناكيا كريستال

منذ حوالي 4 سنوات

#22281

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

مكتب 360

رد

مشروع قانون دارين

منذ حوالي 4 سنوات

#22282

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

المشكلة نفسها

رد

مايكل شاري

منذ حوالي 4 سنوات

#24346

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

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

رد

بلغ

كريستال مايكل شاري

منذ حوالي 4 سنوات

#24347

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

عزيزي مايكل ،
يرجى تشغيل كود فبا أدناه لحل المشكلة.

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 "لا يمكن أن تكون ورقة العمل النشطة فارغة"
خروج الفرعية
إنهاء حالة
نهاية الفرعية

رد

بلغ

باراغ السوماني كريستال

منذ حوالي 3 سنوات

#24348

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

مرحبا كريستال ،

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

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

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

شكر
باراج

رد

كريستال باراغ السوماني

منذ حوالي 3 سنوات

#24349

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

مرحبًا باراغ سوماني ،
يمكن أن يساعدك رمز 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 "لا يمكن أن تكون ورقة العمل النشطة فارغة"
خروج الفرعية
إنهاء حالة
نهاية الفرعية

رد

بلغ

Mehul كريستال

منذ حوالي 10 أشهر

#24350

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

لقد كنت أحاول استخدام النطاق لـ "To" و "CC" ، فهو لا يلتقط القيم من الخلية المحددة. هل يمكنك المساعدة في هذا؟
شكر،
Mehul

رد

باراغ السوماني كريستال

منذ حوالي 3 سنوات

#24351

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

رد

باراج كريستال

منذ حوالي 3 سنوات

#24352

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

رد

بلغ

ارمين

منذ حوالي 4 سنوات

#24839

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

كيف يمكنني إضافة مثال الورقة 2 من المصنف كملف pdf؟

رد

كريستال ارمين

منذ حوالي 4 سنوات

#24840

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

مرحبا ارمين
تحتاج إلى فتح الورقة 2 في المصنف الخاص بك أولاً ثم تشغيل رمز VBA بالخطوات المذكورة أعلاه لتنزيله.

رد

بلغ

توم ح

منذ حوالي 4 سنوات

#25005

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

كيف يمكنني تحرير برنامج VBA النصي أعلاه بحيث يتم حفظ اسم الملف كخلية معينة محددة في الورقة الحالية ، على سبيل المثال الخلية A1؟

رد

كريستال توم ح

منذ حوالي 4 سنوات

#25006

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

مرحبا توم.
آسف لا يمكن أن تساعد في هذا.
مرحبًا بك لنشر أي سؤال في منتدانا: https://www.extendoffice.com/forum.html
ستحصل على المزيد من دعم Excel من محترفي Excel أو غيرهم من محبي Excel.

رد

بلغ

جيمس

منذ حوالي 4 سنوات

#26183

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

مرحبًا ، كيف يمكنني حفظ وإرسال ملف pdf مع اسم المصنف برمز VBA الحالي؟ ماذا أستخدم بدلاً من xSht.Name

رد

كريستال جيمس

منذ حوالي 4 سنوات

#26184

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

مرحبا جيمس،
هل تريد إرسال ورقة العمل النشطة بصيغة pdf وتسميتها باسم المصنف؟

رد

بلغ

رانجا

منذ حوالي 3 سنوات

#29450

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

شكرا انها تعمل.

رد

جايسون

منذ حوالي 3 سنوات

#29502

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

كيف يمكنني جعله يحذف ملف pdf المحفوظ بعد إرساله بالبريد الإلكتروني؟

رد

كريستال جايسون

منذ حوالي 3 سنوات

#29503

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

مرحبا جايسون،
آسف لا أستطيع مساعدتك في ذلك حتى الآن. تحتاج إلى حذفه يدويًا بعد إرساله بالبريد الإلكتروني.

رد

بلغ

الغريب

منذ حوالي 3 سنوات

#30839

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

مرحبا،

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

وفي الخلية H4 أريدها أن تجمع من ثلاث خلايا مختلفة. هل هذا ممكن؟

رد

تايلور الغريب

منذ حوالي 2 سنوات

#30840

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

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

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

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

xFolder = xFolder + "\" xMemberName + xFileDate + ".pdf"

رد

سورا تايلور

منذ حوالي 4 أشهر

#40196

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

أتلقى خطأ عندما أحاول ذلك ، أين يجب أن أضع هذا في الكود؟

رد

كيشور

منذ حوالي 2 سنوات

#32506

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

مرحبا كريستال ،

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

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

شكر

التحيات

كيشور كومار

رد

بلغ

كريستال كيشور

منذ حوالي 2 سنوات

#32507

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

مرحبا،

هل تقصد إضافة قيمة الخلية تلقائيًا إلى 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 "لا يمكن أن تكون ورقة العمل النشطة فارغة"

خروج الفرعية

إنهاء حالة

نهاية الفرعية

رد

بلغ

جيف

منذ حوالي 2 سنوات

#33679

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

إذا كنت أرغب في الحفظ التلقائي في مجلد معين في كل مرة (مما يلغي حاجة المستخدم إلى اختيار المجلد) ، كيف أفعل ذلك؟
السابق. ج: الفواتير / أمريكا الشمالية / العملاء
المساعدة موضع تقدير كبير.

رد

كريستال جيف

منذ حوالي 2 سنوات

#33680

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

مرحبًا جيف ،
هل تقصد حفظ ورقة العمل كملف pdf وحفظها في مجلد معين دون إرسالها؟

رد

بلغ

جيريمي كريستال

منذ حوالي 2 سنوات

#33681

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

أعتقد أن Geoff يعني القدرة على تحديد مجلد معين في الكود الذي يتم حفظ ملف pdf فيه في كل مرة بدلاً من الاضطرار إلى تحديد الموقع يدويًا. ثم يتم إرسال ملف pdf عبر البريد الإلكتروني من هذا المجلد المحدد.

رد

كريستال جيريمي

منذ حوالي 2 سنوات

#33682

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

شكرا لك جيريمي.

رد

بلغ

كريستال جيف

منذ حوالي 2 سنوات

#33683

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

مرحبًا 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 "لا يمكن أن تكون ورقة العمل النشطة فارغة"
خروج الفرعية
إنهاء حالة
نهاية الفرعية

رد

بلغ

أليسون

منذ حوالي 2 سنوات

#34153

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

يعمل هذا الرمز بشكل رائع إلا أنني أريد حفظ ورقة العمل كاسم الورقة + التاريخ (على سبيل المثال ، الورقة 1 أكتوبر 1 2020) ؛ على سطح مكتب المستخدم (سيستخدمه عدة أشخاص وقد تختلف مساراتهم قليلاً). إذا كان ذلك ممكنًا ، فأنا أرغب في تضمين jpg. في النص أيضًا .. يوجد JPG داخل ورقة العمل (خارج منطقة الطباعة) ويتم تخزين الصورة على خادم مشترك .. على الرغم من أن المسار إلى الخادم يختلف حسب مستخدم (بالنسبة لمعظم الأشخاص ، فهو محرك "T" لبعض محركات الأقراص "U")
هل يمكن هذا؟ من فضلك وشكرا مليون مرة.

رد

ديباك

منذ حوالي 2 سنوات

#34748

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

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

رد

بلغ

كريستال ديباك

منذ حوالي سنة واحدة

#34749

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

مرحبًا ، يرجى تجربة رمز 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 "لا يمكن أن تكون ورقة العمل النشطة فارغة"
خروج الفرعية
إنهاء حالة
نهاية الفرعية

رد

بلغ

مليكزوس 94

منذ حوالي سنة واحدة

#35017

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

مرحبا،
إذا كان لدي ورقتان في الملف ، وأود تشغيل هذا الماكرو على ورقة واحدة (عن طريق الضغط على زر) ولكن أرسل ورقة أخرى ، كيف يمكنني الحصول عليها؟

رد

بلغ

هاين

منذ حوالي سنة واحدة

#35061

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

مرحبًا ، أرغب في حفظ هذا في موقع ملف معين ، بالاسم المبني على القيمة الموجودة في الخلية C30 لقد جربت بعض الخيارات ، ولكن استمر في الحصول على أخطاء.

رد

كريستال هاين

منذ حوالي سنة واحدة

#35062

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

مرحبًا هاين ، ربما يمكن أن يساعد الكود أدناه. بعد تشغيل الكود ، حدد مجلدًا معينًا لحفظ ملف 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 "لا يمكن أن تكون ورقة العمل النشطة فارغة"
خروج الفرعية
إنهاء حالة
نهاية الفرعية

رد

بلغ

هاين كريستال

منذ حوالي سنة واحدة

#35063

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

شكرًا على ذلك ، هذا رائع ، لكني أريد تسمية الورقة وفقًا للخلية A1 في الورقة 1. المكان الذي يجب حفظه وفقًا لـ A1 في الورقة 2 على سبيل المثال C: \ Users \ peete \ Dropbox \ Screenshots ، وإرسال بريد إلكتروني إلى عنوان البريد الإلكتروني على ورقة A3 2 الذي قمت بعمله بالفعل.

رد

هاينبيترز كريستال

منذ حوالي سنة واحدة

#35064

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

شكرًا على ذلك ، هذا رائع ، لكني أريد تسمية الورقة وفقًا للخلية A1 في الورقة 1. المكان الذي يجب حفظه وفقًا لـ A1 في الورقة 2 على سبيل المثال C: \ Users \ peete \ Dropbox \ Screenshots ، ولكن يمكن تغييره عندما باستخدام الملف ، وإرسال البريد الإلكتروني إلى عنوان البريد الإلكتروني على ورقة A3 2 ، وهو ما قمت به بالفعل.

رد

بلغ

BenSpo

منذ حوالي سنة واحدة

#35283

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

Hi كريستال ، رمز ممتاز ، شكرًا للمشاركة. هل هناك طريقة لتحديد أوراق متعددة (من نفس المصنف) لحفظ كل منها كملف PDF مستقل ثم إرسالها جميعًا مرفقة في بريد إلكتروني واحد؟

رد

بلغ

كريستال BenSpo

منذ حوالي سنة واحدة

#35284

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

مرحبًا ، يمكن أن يساعدك رمز 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 ثم
'.يرسل
إنهاء حالة
انتهت ب
نهاية الفرعية

رد

بلغ

بيرني رودولف كريستال

منذ حوالي سنة واحدة

#35285

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

مرحبًا ، التغيير الوحيد الذي أواجهه هو إنشاء بريد إلكتروني منفصل لكل مستند pdf تم إنشاؤه.

رد

كريستال بيرني رودولف

منذ حوالي سنة واحدة

#35286

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

مرحبًا ، لإنشاء بريد إلكتروني منفصل لكل مستند pdf ، يمكنك تشغيل VBA يدويًا المتوفر في المنشور في أوراق عمل مختلفة لإنجازه.

رد

بلغ

بيرني رودولف كريستال

منذ حوالي سنة واحدة

#35287

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

لدي أكثر من 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 ثم
.إرسال
خروج الفرعية
إنهاء حالة
انتهت ب

نهاية الفرعية

رد

توري

منذ حوالي سنة واحدة

#35336

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

مرحبًاcrystal
هذا فاب - الشيء الرئيسي الذي أواجهه هو اسم الملف - أود سحب اسم الملف من خلية في ورقة العمل بدلاً من استخدام اسم علامة التبويب. لقد قمت بالفعل بتحرير الكود للحفظ تلقائيًا في مجلد محدد ولكني أواجه صعوبة في اسم الملف.
أي مساعدة يمكنك تقديمها من فضلك؟

رد

كريستال توري

منذ حوالي سنة واحدة

#35337

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

مرحبًا توري ، إذا كنت ترغب في تسمية ملف 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 "لا يمكن أن تكون ورقة العمل النشطة فارغة"
خروج الفرعية
إنهاء حالة
نهاية الفرعية

رد

بلغ

Makeeuropeanu

منذ حوالي سنة واحدة

#35342

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

مرحبًا ، كنت بحاجة إلى شيء مشابه ، لذا ها هو ما حصلت عليه ، فهو يأخذ التاريخ الحالي وينشئ مجلدًا جديدًا باسم التاريخ في موقع معين ، ويضع ملف 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 "لا يمكن أن تكون ورقة العمل النشطة فارغة"
خروج الفرعية
إنهاء حالة
نهاية الفرعية

رد

بلغ

نيكول

منذ حوالي سنة واحدة

#35677

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

كيف يمكنني تحرير هذا الرمز لحفظ الخلايا فقط ("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 "لا يمكن أن تكون ورقة العمل النشطة فارغة"
خروج الفرعية
إنهاء حالة
نهاية الفرعية

رد

RLF نيكول

منذ حوالي سنة واحدة

#35678

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

مرحبًا ، لقد جربت للتو هذا الرمز في إحدى أوراق العمل الخاصة بي ولديّ مناطق طباعة محددة بحيث لا تظهر العناصر الإضافية في الأسفل في ملف pdf. جربها!

رد

رود بينيت

منذ حوالي سنة واحدة

#35699

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

Hi
شكرًا جزيلاً على الكود ولكن هل من الممكن حفظ ملف PDF تلقائيًا في نفس الموقع مثل ملف Excel النشط وبنفس اسم الملف مثل ملف Excel النشط؟
شكرا جزيلا.
قضيب

رد

لا توجد تعليقات منشورة هنا حتى الآن

عرض المزيد

اترك تعليقاتك

النشر كضيف

الدخول

الاسم (مطلوب)

البريد الإلكتروني (مطلوب)

قيم المنشور:

إعادة تعيين

0 الشخصيات

أنا أوافق على أحكام وشروط