By ضيف يوم السبت 01 سبتمبر 2018
الردود 0
الإعجابات 0
المشاهدات 2.6K
الأصوات 0
لقد قمت بتثبيت kutools للمساعدة في مشروع العمل. أقوم أيضًا بإدارة تقرير شركة كبير يحتوي على ماكرو لإنشاء بريد إلكتروني من المعلومات المدخلة. لقد توقف هذا الماكرو عن العمل على جهاز الكمبيوتر الخاص بي. يعمل على أجهزة الكمبيوتر التي لا تحتوي على kutools. هل واجه أي شخص شيئًا كهذا من قبل؟ إليك الماكرو الذي يعمل بشكل جيد على أجهزة الكمبيوتر الأخرى:

Sub Mail_Sheet_Outlook_Body ()
"العمل في Excel 2000-2016
Application.ReferenceStyle = xlA1
خافت rng كمدى
خافت OutApp ككائن
تعتيم البريد الخارجي ككائن
خافت xFolder كسلسلة
خافت xSht كورقة عمل
خافت xSub كسلسلة
استجابة خافتة كسلسلة
خافت Msg كسلسلة
نمط خافت كسلسلة
خافت العنوان كسلسلة

قم بتعيين xSht = ActiveSheet
Msg = "هل أنت متأكد أنك تريد إرسال هذا النموذج عبر البريد الإلكتروني؟" تحديد الرسالة.
النمط = vbYesNo + vbCritical + vbDefaultButton2 'تحديد الأزرار.
Title = "إرسال تأكيد بالبريد الإلكتروني" "تحديد العنوان.
الاستجابة = MsgBox (رسالة ، نمط)

إذا كانت الاستجابة = vbYes ثم
xFolder = Environ ("USERPROFILE") + "\ Desktop \" + "\ نموذج التدقيق الميداني -" + CStr (xSht.Cells (19، "A"). Value) + "-. pdf"
'xSub = "تدقيق ميداني للمتجر" + CStr (xSht.Cells (19، "A"). القيمة)
مع التطبيق
.EnableEvents = خطأ
.ScreenUpdating = خطأ
انتهت ب

تعيين rng = لا شيء
تعيين rng = ActiveSheet.UsedRange
يمكنك أيضًا استخدام اسم الورقة
'Set rng = Sheets ("YourSheet"). UsedRange

تعيين OutApp = CreateObject ("Outlook.Application")
تعيين OutMail = OutApp.CreateItem (0)
خافت varCellvalue As Long




على خطأ استئناف التالي
مع OutMail
. إلى = ""
.CC = ""
.BCC = ""
.Subject = "ملخص"
المرفقات. إضافة xFolder
.HTMLBody = RangetoHTML (rng)
.Display "أو استخدام

انتهت ب
على خطأ GoTo 0

مع التطبيق
.EnableEvents = صحيح
.ScreenUpdating = صحيح
انتهت ب

تعيين OutMail = لا شيء
تعيين OutApp = لا شيء
إنهاء حالة
نهاية الفرعية


وظيفة RangetoHTML (rng كنطاق)
"العمل في Office 2000-2016
خافت fso ككائن
خافت ts ككائن
خافت درجة الحرارة: ملف كسلسلة
Dim TempWB كمصنف

TempFile = Environ $ ("temp") & "\" & Format (Now، "dd-mm-yy h-mm-ss") & ".htm"

انسخ النطاق وأنشئ مصنفًا جديدًا للصق البيانات فيه
rng.نسخ
تعيين TempWB = المصنفات.إضافة (1)
مع أوراق TempWB (1)
الخلايا (1) معجون خاص: = 8
. الخلايا (1). لصق خاص xlPasteValues،، False، False
. الخلايا (1) .PasteSpecial xlPasteFormats ، ، ، False ، False
. الخلايا (1)
Application.CutCopyMode = خطأ
على خطأ استئناف التالي
.DrawingObjects.Visible = صحيح
رسم الكائنات. حذف
على خطأ GoTo 0
انتهت ب

انشر الورقة في ملف htm
باستخدام TempWB.PublishObjects.Add (_
نوع المصدر: = xlSourceRange ، _
اسم الملف: = TempFile ، _
الورقة: = TempWB.Sheets (1). Name، _
المصدر: = TempWB.Sheets (1) .UsedRange.Address، _
HtmlType: = xlHtmlStatic)
انشر (صحيح)
انتهت ب

اقرأ جميع البيانات من ملف htm إلى RangetoHTML
تعيين fso = CreateObject ("Scripting.FileSystemObject")
قم بتعيين ts = fso.GetFile (TempFile) .OpenAsTextStream (1، -2)
RangetoHTML = ts.readall
ts. إغلاق
RangetoHTML = استبدال (RangetoHTML، "align = center x: publishsource ="، _
"محاذاة = يسار x: publishsource =")

"أغلق TempWB
TempWB.Close Savechanges: = False

احذف ملف htm الذي استخدمناه في هذه الوظيفة
قتل TempFile
تعيين ts = لا شيء
تعيين fso = لا شيء
ضبط TempWB = لا شيء

نهاية وظيفة
عرض مشاركة كاملة