إرسال بريد إلكتروني: عنوان في الخلية D1 و D2 في هذا الموضوع، والنص في D3
'اختبار مع Outlook Express 5.
فرعية EnvoiUnMail ()
الشمس Mailad كسلسلة
جي اس قاتمة وسلسلة
Subj خافت كسلسلة
الشمس URLto كسلسلة
Mailad = المدى ( "D1")
Subj = المدى ( "D2")
جي اس جي اس = والمدى ( "D3")
URLto = "ميلتو:" Mailad & & & & Subj "والجسم =" & MSG "؟ الموضوع ="
ActiveWorkbook.FollowHyperlink العنوان: = URLto
نهاية الفرعية
فرعية EnvoiFeuilMail ()
كما مصنف خافت WBK
ThisWorkbook.Sheets ( "SHEET1"). نسخة
تعيين WBK = ActiveWorkbook
SendKeys "{E}"
Wbk.SendMail "dj@free.fr"، "ورقة العقد للتوقيع"، صحيح
"صحيح لاستلام إشعار
savechanges Wbk.Close: = خطأ
تعيين WBK = لا شيء
نهاية الفرعية
يمكنك إضافة عناوين، فقط تغيير:
وA1 مرجع: A11
حلقة 1 إلى 11
والجدول صفيف (myadress (11) الخ ..
فرعية EnvoiClasseurAd ()
الشمس myadress (1 إلى 10)
تعيين mylst = ActiveSheet.Range ( "A1: A10")
عدد = 1
إرسال للكل في mylst
إذا ليون (إرسال) ثم myadress (عدد) = إرسال: عدد = عدد + 1
التالي
ActiveWorkbook.SendMail المستلمين: = صفيف (myadress (1) myadress (2) _
myadress (3)، myadress (4)، myadress (5) myadress (6) myadress (7)، _
myadress (8) myadress (9) myadress (10)) الموضوع: = "هذا هو المصنف يسمى"
نهاية الفرعية
فرعية GraphJPG ()
كما مخطط خافت MyChart
تعيين MyChart ActiveSheet.ChartObjects = (1) .chart
MyChart.Export اسم الملف: = "C: \ ajeter \ Graph1.jpg" FILTERNAME: = "JPG"
نهاية الفرعية
لورانس لام
فرعية exportgif ()
الشمس بيتش والمدى
تعيين المدى = Application.InputBox (موجه: = "اختر منطقتك: (خروج A1 B10)" _
العنوان: = "تحديد المنطقة"، رد: = "$ A $ 1"، النوع: = 8)
Application.ScreenUpdating = خطأ
Workbooks.Add
Plage.CopyPicture
ActiveSheet.Paste
ActiveSheet.ChartObjects.Add مع (0، 0، _
Selection.Width، Selection.Height) .chart
.Paste
.export "C: \ ajeter \ Test.gif"، "GIF"
ينتهي مع
خطأ ActiveWorkbook.Close
نهاية الفرعية
يحفظ ملف أتش تي أم أل شاطئ تشارلي بالش
اختبارات إذا كان اتصال نشط
مؤلف مجهول
الجمهور CONST ERROR_SUCCESS = 0 &
CONST الجمهور APINULL = 0 &
الجمهور CONST HKEY_LOCAL_MACHINE = & H80000002
طالما رمز النتيجة العامة
إعلان وظيفة RegCloseKey ليب "advapi32.dll" (الأساسية ByVal HKEY وونغ) وونغ
إعلان وظيفة RegOpenKey ليب "advapi32.dll" الاسم المستعار "RegOpenKeyA" _
(الأساسية ByVal HKEY وطويل، الأساسية ByVal كسلسلة lpSubKey، phkResult وونغ) طالما
إعلان وظيفة RegQueryValueEx ليب "advapi32.dll" الاسم المستعار "RegQueryValueExA" _
(الأساسية ByVal HKEY طالما، الأساسية ByVal lpValueName وسلسلة، _
LpReserved الأساسية ByVal وطويل، lpType وطويل، _
lpData وأي، lpcbData وطويل) وطويل
أعلن خاصة وظيفة InternetAutodial ليب "WININET" _
(الأساسية ByVal dwFlags وطويل، الأساسية ByVal hwndParent وونغ) وونغ
أعلن خاصة وظيفة InternetAutodialHangup ليب "WININET.DLL" _
(الأساسية ByVal dwReserved وونغ) وونغ
ActiveConnection وظيفة عامة () ومنطقية
طالما خافت HKEY
الشمس lpSubKey كسلسلة
طالما خافت phkResult
الشمس lpValueName كسلسلة
طالما خافت lpReserved
طالما خافت lpType
طالما خافت lpData
طالما خافت lpcbData
ActiveConnection = خطأ
lpSubKey = "نظام \ نقرا \ خدمات \ ريموت"
رمز النتيجة = RegOpenKey (HKEY_LOCAL_MACHINE، lpSubKey، phkResult)
إذا رمز النتيجة = ERROR_SUCCESS ثم
HKEY = phkResult
lpValueName = "اتصال عن بعد"
lpReserved = APINULL
lpType = APINULL
lpData = APINULL
lpcbData = APINULL
رمز النتيجة _ = RegQueryValueEx
(HKEY، lpValueName، lpReserved، lpType، الأساسية ByVal lpData، lpcbData)
lpcbData = لين (lpData)
رمز النتيجة _ = RegQueryValueEx
(HKEY، lpValueName، lpReserved، lpType، lpData، lpcbData)
إذا رمز النتيجة = ERROR_SUCCESS ثم
إذا = lpData 0 ثم
ActiveConnection = خطأ
آخر
ActiveConnection = صحيح
إنهاء حالة
إنهاء حالة
RegCloseKey (HKEY)
إنهاء حالة
وظيفة نهاية
اختبار الاتصال
دون اختبار ()
إذا = ActiveConnection صحيح ثم
استدعاء MsgBox ( "أن يكون لديك اتصال نشط." VbInformation)
آخر
استدعاء MsgBox ( "ليس لديك اتصال نشط." VbInformation)
إنهاء حالة
نهاية الفرعية
مع XP
أعلن خاصة وظيفة InternetGetConnectedState ليب "WININET.DLL" _
(الأساسية ByRef lpSFlags وطويل، dwReserved الأساسية ByVal وونغ) وونغ
وظيفة عامة IsConnectedToInternet (اختياري ConnectMode وعدد صحيح) ومنطقية
طالما خافت LRESULT
IsConnectedToInternet = InternetGetConnectedState (LRESULT، 0 &)
ConnectMode = LRESULT
وظيفة نهاية
جنوب TEST2 ()
إذا IsConnectedToInternet = صحيح ثم
استدعاء MsgBox ( "أن يكون لديك اتصال نشط." VbInformation)
آخر
استدعاء MsgBox ( "ليس لديك اتصال نشط." VbInformation)
إنهاء حالة
نهاية الفرعية
يبدأ اتصال
أعلن خاصة وظيفة InternetAutodial ليب "WININET" _
(الأساسية ByVal dwFlags وطويل، الأساسية ByVal hwndParent وونغ) وونغ
أعلن خاصة وظيفة InternetAutodialHangup ليب "WININET.DLL" _
(الأساسية ByVal dwReserved وونغ) وونغ
دون دخول ()
InternetAutodial 1، 0
نهاية الفرعية
يتوقف اتصال
من الباطن حاليا ()
InternetAutodialHangup (0 &)
نهاية الفرعية
دست يحتوي متغير عنوان البريد الإلكتروني.
يحتوي على متغير Sujt سطر الموضوع.
يحتوي جي اس متغير نص الرسالة.
فرعية MailAvecOE ()
دست كسلسلة خافت
الشمس Sujt كسلسلة
جي اس قاتمة وسلسلة
دست = "dj@free.fr"
Sujt = "إرسال اختبار مع Excel"
جي اس = "مرحبا، يرسل إكسل رسالة مع عمر الفاروق"
قذيفة "C: \ ملفات البرنامج \ برنامج Outlook Express \ msimn.exe لها" & _
"/ Mailurl: ميلتو:" عنوان & & & & Sujt "والجسم =" & رسائل و"" "؟ الموضوع ="
نهاية الفرعية
فرعية MailAvecOEClasseur ()
الشمس دست، Sujt، جي اس كسلسلة
الشمس theFile
TheFile = "C: \ TEMP \ monfich.xls"
دست = "dj@free.fr"
Sujt = "إرسال اختبار مع Excel"
جي اس = "مرحبا، يرسل إكسل رسالة ومصنف مع عمر الفاروق"
قذيفة "C: \ ملفات البرنامج \ برنامج Outlook Express \ msimn.exe لها" & _
"/ Mailurl: ميلتو:" عنوان & & & & Sujt "والجسم =" & رسائل و"" "؟ الموضوع ="
SendKeys "٪ I" و "ص" وtheFile و"~" & "٪ ق"
نهاية الفرعية
معنى الأحرف بعد "SendKeys"
*٪ I و P = إدخال المرفق في Outlook Express. (٪ = البديل)
* ~ = التحقق. (~ = أدخل)
* =٪ إرسال S.
فرعية MailFeuilleOE ()
الشمس دست، Sujt، جي اس كسلسلة
الشمس RepName
ActiveSheet.Copy
ActiveWorkbook.SaveAs اسم الصورة: = "C: \ مؤقت \ Test.xls"
RepName = "C: \ مؤقت \ Test.xls"
دست = "dj@free.fr"
Sujt = "اختبار بإرسال ورقة مع Excel"
جي اس = "مرحبا، إكسل يرسل لك ورقة مع عمر الفاروق"
قذيفة "C: \ ملفات البرنامج \ برنامج Outlook Express \ msimn.exe لها" & _
"/ Mailurl: ميلتو:" عنوان & & & & Sujt "والجسم =" & رسائل و"" "؟ الموضوع ="
SendKeys "٪ I" و "ص" وRepName و"~" & "٪ ق"
ActiveWorkbook.Close
نهاية الفرعية
هذا الماكرو يرسل النطاق A1: A10، يمكنك تغيير من الواضح أن هذا الخط المدى. ( "A1: A10") نسخة
لإرسال مجموعة خلية أخرى.
فرعية EnvoiSelectionparMail ()
الشمس دست، Sujt، جي اس كسلسلة
الشمس theFile
مجموعة ( "A1: A10") نسخ.
Workbooks.Add
ActiveSheet.Paste
ActiveWorkbook.SaveAs اسم الصورة: = "C: \ مؤقت \ Test.xls"
TheFile = "C: \ مؤقت \ Test.xls"
دست = "dj@free.fr"
Sujt = "إرسال اختبار مع Excel"
جي اس = "مرحبا، إكسل يرسل لك مجموعة من الخلايا مع عمر الفاروق"
قذيفة "C: \ ملفات البرنامج \ برنامج Outlook Express \ msimn.exe لها" & _
"/ Mailurl: ميلتو:" عنوان & & & & Sujt "والجسم =" & رسائل و"" "؟ الموضوع ="
SendKeys "٪ I" و "ص" وtheFile و"~" & "٪ ق"
ActiveWorkbook.Close
نهاية الفرعية
قائمة المستلمين هي في النطاق A1: A10
فرعية Mailingliste ()
دست كسلسلة خافت
الشمس Sujt كسلسلة
جي اس قاتمة وسلسلة
لكل Lescellules في نطاق ( "A1: A10")
دست = Lescellules.Value
Sujt = "إرسال اختبار مع Excel"
جي اس = "مرحبا، يرسل إكسل رسالة مع عمر الفاروق" _
VbNewLine وو"Daniel.j"
قذيفة "C: \ ملفات البرنامج \ برنامج Outlook Express \ msimn.exe لها" & _
"/ Mailurl: ميلتو:" عنوان & & & & Sujt "والجسم =" & رسائل و"" "؟ الموضوع ="
SendKeys "٪ ق"
التالي
'ونص الرسالة موجود في مربع النص:
جي اس = أوراق العمل ( "اسم الورقة"). الأشكال ( "مربع نص 1"). TextFrame.Characters.Text
نهاية الفرعية
أعلن خاصة الدالة ShellExecute ليب "SHELL32.DLL" الاسم المستعار _
"ShellExecuteA" (الأساسية ByVal hWnd عنصر وطويل، الأساسية ByVal lpOperation وسلسلة الأساسية ByVal _
lpFile وسلسلة الأساسية ByVal lpParameters وسلسلة الأساسية ByVal _ كما lpDirectory
سلسلة الأساسية ByVal nShowCmd وونغ) طالما
خاصة CONST SW_SHOWNORMAL وطويل = 1
فرعية LanceNavigateurPardefaut ()
عنوان URL وسلسلة خافت
عنوان URL = "http://dj.joss.free.fr/sommaire.htm"
ShellExecute HWND "فتح"، وعنوان الموقع، vbNullString، vbNullString، SW_SHOWNORMAL
نهاية الفرعية
أعلن خاصة وظيفة InternetAutodial ليب "WININET" _
(الأساسية ByVal dwFlags وطويل، الأساسية ByVal hwndParent وونغ) وونغ
أعلن خاصة وظيفة InternetAutodialHangup ليب "WININET.DLL" _
(الأساسية ByVal dwReserved وونغ) وونغ
فرعية OuvreHTM ()
InternetAutodial 1، 0
على خطأ استئناف التالي
Workbooks.OpenText "HTTP: /dj.joss.free.fr/sommaire.htm" xlWindows، _
1 xlDelimited، ConsecutiveDelimiter: = كاذبة، تبويب: = صحيح
إذا خطأ ثم MsgBox Err.Description: إنهاء الفرعية
على خطأ الانتقال إلى 0
تشدر "C: \ ajeter \" لم يتغير
ActiveWorkbook.SaveAs اسم الصورة: = "lapage.xls"
نهاية الفرعية
"أوقفوا اتصال
من الباطن حاليا ()
InternetAutodialHangup (0 &)
نهاية الفرعية
