حمدى الظابط قام بنشر يناير 7, 2023 قام بنشر يناير 7, 2023 (معدل) السلام عليكم الموضوع / ارسال رسالة نصية واتساب التوضيح / عند ارسال الرسالة يجب كتابة اسم المرسل اولا فى سطر منفرد ثم الرسالة النصية ثانيا ثم ظهور المرفق ثالثا ثم عنوان الراسل رابعابسطر منفرد المشكلة / ظهور كل مربعات النص متلاصقة بصورة غير واضحة كما فى الصورة المرفقة المطلوب / تعريف مربعات النص للكود بصورة تظهر ما تم ذكره بصورة منسقة ومرتبه وواضحة وكل الاحترام والتقدير للجميع تجرية.rar تم تعديل يناير 7, 2023 بواسطه حمدى الظابط
jjafferr قام بنشر يناير 7, 2023 قام بنشر يناير 7, 2023 وعليكم السلام 🙂 في الواتساب ، للإنتقال للسطر التالي ، لا تستعمل vbcrlf او chr(10) او chr(13) ، وانما استعمل "%0a" وكذلك تم ترجمة هذه الجزئية من موقع الواتساب: https://faq.whatsapp.com/539178204879377/?locale=en_US يتيح لك WhatsApp تنسيق النص داخل رسائلك. يرجى ملاحظة أنه لا يوجد خيار لتعطيل هذه الميزة. مائل لجعل رسالتك مائلة ، ضع شرطة سفلية على جانبي النص: _نص_ بالخط العريض لجعل رسالتك غامقة ، ضع علامة النجمة على جانبي النص: *نص* يتوسطه خط لتخطي رسالتك ، ضع علامة تلدة على جانبي النص: ~ نص ~ مونوسبيس لفرد رسالتك ، ضع ثلاث علامات خلفية على جانبي النص: ```نص``` ملحوظة: بدلاً من ذلك ، يمكنك استخدام الاختصارات على Android و iPhone. Android: اضغط مع الاستمرار على النص الذي تدخله في حقل النص ، ثم اختر غامق أو مائل أو المزيد. انقر على "المزيد" لاختيار خط يتوسطه خط أو مسافة أحادية. iPhone: اضغط على النص الذي تدخله في حقل النص> تحديد أو تحديد الكل> B_I_U. ثم اختر Bold أو Italic أو Strikethrough أو Monospace. جعفر 2 1
Moosak قام بنشر يناير 7, 2023 قام بنشر يناير 7, 2023 (معدل) 1 ساعه مضت, jjafferr said: في الواتساب ، للإنتقال للسطر التالي ، لا تستعمل vbcrlf او chr(10) او chr(13) ، وانما استعمل "%0a" شكرا لك عمي جعفر ، كنت أعاني من هذي المشكلة وما عارف كيف أحلها .. 😅 والحين بعد ما عرفت .. عملت هذي الدالة لاستبدال فواصل الفقرات بالرمز "%0a" واللي تقوم بعمل السطر الفاصل بين الفقرات كما يريده الواتسأب : ' =================================(وهذه دالة لجعل الواتسأب يقبل السطور الجديدة في النص المرسل) Function ReplaceLineBreaks(text As String) As String ReplaceLineBreaks = Replace(text, vbCrLf, " %0a ") ReplaceLineBreaks = Replace(ReplaceLineBreaks, Chr(10), " %0a ") ReplaceLineBreaks = Replace(ReplaceLineBreaks, Chr(13), " %0a ") End Function وتستخدم كالتالي قبل ما تدخل في كود الإرسال : Dim MSG as String MSG = ReplaceLineBreaks(Me.MsgText) جربتها في برنامج مرسال الواتسأب ونجحت ولله الحمد 😊 تم تعديل يناير 7, 2023 بواسطه Moosak 2 1
jjafferr قام بنشر يناير 7, 2023 قام بنشر يناير 7, 2023 (معدل) 46 دقائق مضت, Moosak said: جربتها في برنامج مرسال الواتسأب ونجحت ولله الحمد 😊 الحمدلله 🙂 جعفر تم تعديل يناير 7, 2023 بواسطه jjafferr 1
حمدى الظابط قام بنشر يناير 7, 2023 الكاتب قام بنشر يناير 7, 2023 السلام عليكم وحده وحده عليه علشان انا لسه تلميذ بيتعلم من اساتذته اطبق الكلام ده ازاى ومكانه فين فى الكود
Moosak قام بنشر يناير 7, 2023 قام بنشر يناير 7, 2023 وعليكم السلام 16 دقائق مضت, حمدى الظابط said: اطبق الكلام ده ازاى ومكانه فين فى الكود أستاذ حمدي .. في زر الارسال .. وقبل ما يشتغل الكود اللي يفتح الواتسأب .. تستبدل النص اللي حترسله ولنفرض أنه موجود في مربع النص Me.MsgText تستبدله بالنص الجديد اللي حتعطيك إياه الدالة اللي ذكرتها سابقا كما يلي : تعرف متغير جديد اسمه MSG علشان تحفظ فيه النص المراد إرساله بعد الاستبدال هكذا : Dim MSG as String MSG = ReplaceLineBreaks(Me.MsgText) وبعدها تخلي الواتسأب يرسل لك النص اللي متخزن في المتغير MSG .. 🙂 1
حمدى الظابط قام بنشر يناير 7, 2023 الكاتب قام بنشر يناير 7, 2023 16 دقائق مضت, Moosak said: وعليكم السلام أستاذ حمدي .. في زر الارسال .. وقبل ما يشتغل الكود اللي يفتح الواتسأب .. تستبدل النص اللي حترسله ولنفرض أنه موجود في مربع النص Me.MsgText تستبدله بالنص الجديد اللي حتعطيك إياه الدالة اللي ذكرتها سابقا كما يلي : تعرف متغير جديد اسمه MSG علشان تحفظ فيه النص المراد إرساله بعد الاستبدال هكذا : Dim MSG as String MSG = ReplaceLineBreaks(Me.MsgText) وبعدها تخلي الواتسأب يرسل لك النص اللي متخزن في المتغير MSG .. 🙂 بعد التجربة حذفت Text عندما هر لى حطأ ثم ظهر لى هذا الخطأ كما فى الصورة
Moosak قام بنشر يناير 7, 2023 قام بنشر يناير 7, 2023 (معدل) 1 ساعه مضت, Moosak said: ' =================================(وهذه دالة لجعل الواتسأب يقبل السطور الجديدة في النص المرسل) Function ReplaceLineBreaks(text As String) As String ReplaceLineBreaks = Replace(text, vbCrLf, " %0a ") ReplaceLineBreaks = Replace(ReplaceLineBreaks, Chr(10), " %0a ") ReplaceLineBreaks = Replace(ReplaceLineBreaks, Chr(13), " %0a ") End Function أستاذ حمدي نسيت تشيل كود الدالة وتخليه في أي موديول عندك 🙂 وما دام مربع النص معاك اسمه MSG أيضا .. أفضل لك أن تغير اسم المتغير لاسم ثاني (strMSG) مثلا ... وذلك لتجنب حصول أخطاء في الكود تم تعديل يناير 7, 2023 بواسطه Moosak 1
حمدى الظابط قام بنشر يناير 7, 2023 الكاتب قام بنشر يناير 7, 2023 8 دقائق مضت, Moosak said: أستاذ حمدي نسيت تشيل كود الدالة وتخليه في أي موديول عندك 🙂 وما دام مربع النص معاك اسمه MSG أيضا .. أفضل لك أن تغير اسم المتغير لاسم ثاني (strMSG) مثلا ... وذلك لتجنب حصول أخطاء في الكود استاذى الفاضل الكريم هل ممكن تطبيق ذلك على الملف المرفق واكون شاكر جدا
Moosak قام بنشر يناير 7, 2023 قام بنشر يناير 7, 2023 1 دقيقه مضت, حمدى الظابط said: هل ممكن تطبيق ذلك على الملف المرفق للأسف ما استطعت تشغيله .. يظهر لي أخطاء ولا يعمل .. 1
حمدى الظابط قام بنشر يناير 7, 2023 الكاتب قام بنشر يناير 7, 2023 (معدل) 14 دقائق مضت, Moosak said: للأسف ما استطعت تشغيله .. يظهر لي أخطاء ولا يعمل .. Dim IEE As Object Dim SQL As String Dim fso As Object Dim fldrname As String Dim fldrpath As String Dim Mytoname As String Dim stname1 As String Dim rs As DAO.Recordset Set rs = CurrentDb.OpenRecordset("email") rs.MoveLast: rs.MoveFirst Dim IE As Object DoCmd.RunCommand acCmdSaveRecord If Nz(DCount("SelectRow", "email", "SelectRow = 'R'"), 0) = 0 Then MsgBox "يجب اختيار المرسل اليه اولا", vbCritical + vbMsgBoxRight, "تنبيه" Exit Sub End If Me.myname.SetFocus If IsNull(Me.msg) Then MsgBox "لايوجد نص للارسال", vbCritical + vbMsgBoxRight, "تنبيه" Exit Sub End If If IsNull([email1].Form![phone_number]) Then MsgBox "لايوجد رقم هاتف", vbCritical + vbMsgBoxRight, "تنبيه" Exit Sub End If DoCmd.OpenForm "email4", acNormal Set IE = CreateObject("InternetExplorer.Application") IE.Navigate "whatsapp://send?phone=" & rs!phone_number & "&text=""*" & " || *" & Me.myname.Value & "*" & " || *" & Me.msg.Value & "*" & " || *" & Me.attach.Value & "* || " & "المرسل : *" & Me.sub & "*" & "& app_sent =0" Pause 3 SendKeys "{TAB}" Call SendKeys("~", True) If Not rs.BOF And Not rs.EOF Then rs.MoveFirst While (Not rs.EOF) If rs.Fields("SelectRow") = "R" Then Mytoname = rs.Fields(0) stname1 = rs.Fields("toname") Set IE = CreateObject("InternetExplorer.Application") IE.Navigate "whatsapp://send?phone=" & rs!phone_number & "&text=" Pause 3 Set IE = Nothing Set IEE = Nothing Dim objClipboard As Object Set objClipboard = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") objClipboard.SetText (MyFile) objClipboard.PutInClipboard Pause 5 SendKeys "+{TAB}" Call SendKeys("{Enter}", True) Pause 2 Call SendKeys("{Enter}", True) Pause 5 Langauge ELanguage.en Pause 5 Call SendKeys("^v", True) Call SendKeys("{Enter}", True) Pause 5 Set objClipboard = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") objClipboard.SetText (Me.msg) objClipboard.PutInClipboard Pause 1 Call SendKeys("^v", True) Pause 5 Call SendKeys("{Enter}", True) Pause 1 DoCmd.SetWarnings False DoCmd.RunSQL "UPDATE email SET[SendStuts]='تم الارسال' , SelectRow ='T' WHERE [ID]=" & Mytoname DoCmd.Requery DoCmd.SetWarnings True SendKeys "+{TAB}" SendKeys "+{TAB}" SendKeys "+{TAB}" SendKeys "+{TAB}" SendKeys "+{TAB}" SendKeys "+{TAB}" End If rs.MoveNext Wend End If rs.Close Set rs = Nothing MsgBox "تم الارسال" End Sub تم تعديل يناير 7, 2023 بواسطه jjafferr لتنسيق الكود: استعمال <> القائمة ، ووضع الكود في نافذته
حمدى الظابط قام بنشر يناير 7, 2023 الكاتب قام بنشر يناير 7, 2023 (معدل) 20 دقائق مضت, Moosak said: للأسف ما استطعت تشغيله .. يظهر لي أخطاء ولا يعمل .. اتفضل الملف بعد حذف كل المفاتيح التى ليس لها علاقة بعنوان الموضوع الموجود هو زر الارسال وزر ارفاق صورة للتجربة ولك جزيل الشكر والاحترام تجرية.rar تم تعديل يناير 7, 2023 بواسطه حمدى الظابط
Moosak قام بنشر يناير 7, 2023 قام بنشر يناير 7, 2023 غير هذا : 8 دقائق مضت, حمدى الظابط said: Set IE = CreateObject("InternetExplorer.Application") IE.Navigate "whatsapp://send?phone=" & rs!phone_number & "&text=""*" & " || *" & Me.myname.Value & "*" & " || *" & Me.msg.Value & "*" & " || *" & Me.attach.Value & "* || " & "المرسل : *" & Me.sub & "*" & "& app_sent =0" إلى : Dim strMSG As String strMSG = " || *" & Me.myname.Value & "*" & " || *" & Me.msg.Value & "*" & " || *" & Me.attach.Value & "* || " & "المرسل : *" & Me.sub strMSG = ReplaceLineBreaks(strMSG) Set IE = CreateObject("InternetExplorer.Application") IE.Navigate "whatsapp://send?phone=" & rs!phone_number & "&text=""*" & strMSG & "*" & "& app_sent =0" وهذا : 10 دقائق مضت, حمدى الظابط said: objClipboard.SetText (Me.msg) إلى : objClipboard.SetText ReplaceLineBreaks(Me.msg) 1
حمدى الظابط قام بنشر يناير 7, 2023 الكاتب قام بنشر يناير 7, 2023 (معدل) 49 دقائق مضت, Moosak said: غير هذا : إلى : Dim strMSG As String strMSG = " || *" & Me.myname.Value & "*" & " || *" & Me.msg.Value & "*" & " || *" & Me.attach.Value & "* || " & "المرسل : *" & Me.sub strMSG = ReplaceLineBreaks(strMSG) Set IE = CreateObject("InternetExplorer.Application") IE.Navigate "whatsapp://send?phone=" & rs!phone_number & "&text=""*" & strMSG & "*" & "& app_sent =0" وهذا : إلى : objClipboard.SetText ReplaceLineBreaks(Me.msg) بعد التجربة وبعد الاحتفاظ بكود الدالة لم يتم الارسال تم تعديل يناير 7, 2023 بواسطه حمدى الظابط
qathi قام بنشر يناير 7, 2023 قام بنشر يناير 7, 2023 نريد أن نرى هذه الأفكار وغيرها في ملف متكامل وياريت إرسال النص مع صورة من الاكسس عبر الواتس
طاهر الوليدي قام بنشر يناير 7, 2023 قام بنشر يناير 7, 2023 انا اعمل على هده الفكره نموذجين لارسال وتساب وايميل.rar
Moosak قام بنشر يناير 7, 2023 قام بنشر يناير 7, 2023 5 ساعات مضت, حمدى الظابط said: وبعد الاحتفاظ بكود الدالة لم يتم الارسال لا يزال البرنامج يخبرك أنك لم تضف الدالة التالية لبرنامجك 🙂 : ' =================================(وهذه دالة لجعل الواتسأب يقبل السطور الجديدة في النص المرسل) Function ReplaceLineBreaks(text As String) As String ReplaceLineBreaks = Replace(text, vbCrLf, " %0a ") ReplaceLineBreaks = Replace(ReplaceLineBreaks, Chr(10), " %0a ") ReplaceLineBreaks = Replace(ReplaceLineBreaks, Chr(13), " %0a ") End Function أضفها في الأسفل تماما ( أسفل جميع الأكواد ) في نفس الصفحة مثلا .. وجرب من جديد 1
حمدى الظابط قام بنشر يناير 7, 2023 الكاتب قام بنشر يناير 7, 2023 (معدل) 3 ساعات مضت, Moosak said: لا يزال البرنامج يخبرك أنك لم تضف الدالة التالية لبرنامجك 🙂 : ' =================================(وهذه دالة لجعل الواتسأب يقبل السطور الجديدة في النص المرسل) Function ReplaceLineBreaks(text As String) As String ReplaceLineBreaks = Replace(text, vbCrLf, " %0a ") ReplaceLineBreaks = Replace(ReplaceLineBreaks, Chr(10), " %0a ") ReplaceLineBreaks = Replace(ReplaceLineBreaks, Chr(13), " %0a ") End Function أضفها في الأسفل تماما ( أسفل جميع الأكواد ) في نفس الصفحة مثلا .. وجرب من جديد السلام عليكم بعد التجربة النتيجة كما كانت بمرفق الموضوع بل بيتم ارسال الرسالة مرتين لنفس الشخص كما موجود فى الصورة وهذا هو الكود بعد التعديل تعبتك معايا ارجو قبول الاعتذار Dim IEE As Object Dim SQL As String Dim fso As Object Dim fldrname As String Dim fldrpath As String Dim Mytoname As String Dim stname1 As String Dim rs As DAO.Recordset Set rs = CurrentDb.OpenRecordset("email") rs.MoveLast: rs.MoveFirst Dim IE As Object DoCmd.RunCommand acCmdSaveRecord If Nz(DCount("SelectRow", "email", "SelectRow = 'R'"), 0) = 0 Then MsgBox "يجب اختيار المرسل اليه اولا", vbCritical + vbMsgBoxRight, "تنبيه" Exit Sub End If Me.myname.SetFocus If IsNull(Me.msg) Then MsgBox "لايوجد نص للارسال", vbCritical + vbMsgBoxRight, "تنبيه" Exit Sub End If If IsNull([email1].Form![phone_number]) Then MsgBox "لايوجد رقم هاتف", vbCritical + vbMsgBoxRight, "تنبيه" Exit Sub End If DoCmd.OpenForm "email4", acNormal Set IE = CreateObject("InternetExplorer.Application") IE.Navigate "whatsapp://send?phone=" & rs!phone_number & "&text=""*" & " || *" & Me.myname.Value & "*" & " || *" & Me.msg.Value & "*" & " || *" & Me.attach.Value & "* || " & "المرسل : *" & Me.sub & "*" & "& app_sent =0" Pause 3 SendKeys "{TAB}" Call SendKeys("~", True) If Not rs.BOF And Not rs.EOF Then rs.MoveFirst While (Not rs.EOF) If rs.Fields("SelectRow") = "R" Then Mytoname = rs.Fields(0) stname1 = rs.Fields("toname") Dim strMSG As String strMSG = " || *" & Me.myname.Value & "*" & " || *" & Me.msg.Value & "*" & " || *" & Me.attach.Value & "* || " & "المرسل : *" & Me.sub strMSG = ReplaceLineBreaks(strMSG) Set IE = CreateObject("InternetExplorer.Application") IE.Navigate "whatsapp://send?phone=" & rs!phone_number & "&text=""*" & strMSG & "*" & "& app_sent =0" Pause 3 Set IE = Nothing Set IEE = Nothing Dim objClipboard As Object Set objClipboard = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") objClipboard.SetText (MyFile) objClipboard.PutInClipboard Pause 5 SendKeys "+{TAB}" Call SendKeys("{Enter}", True) Pause 2 Call SendKeys("{Enter}", True) Pause 5 Langauge ELanguage.en Pause 5 Call SendKeys("^v", True) Call SendKeys("{Enter}", True) Pause 5 Set objClipboard = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") objClipboard.SetText ReplaceLineBreaks(Me.msg) objClipboard.PutInClipboard Pause 1 Call SendKeys("^v", True) Pause 5 Call SendKeys("{Enter}", True) Pause 1 DoCmd.SetWarnings False DoCmd.RunSQL "UPDATE email SET[SendStuts]='تم الارسال' , SelectRow ='T' WHERE [ID]=" & Mytoname DoCmd.Requery DoCmd.SetWarnings True SendKeys "+{TAB}" SendKeys "+{TAB}" SendKeys "+{TAB}" SendKeys "+{TAB}" SendKeys "+{TAB}" SendKeys "+{TAB}" End If rs.MoveNext Wend End If rs.Close Set rs = Nothing MsgBox "تم الارسال" End Sub ' =================================(وهذه دالة لجعل الواتسأب يقبل السطور الجديدة في النص المرسل) Function ReplaceLineBreaks(text As String) As String ReplaceLineBreaks = Replace(text, vbCrLf, " %0a ") ReplaceLineBreaks = Replace(ReplaceLineBreaks, Chr(10), " %0a ") ReplaceLineBreaks = Replace(ReplaceLineBreaks, Chr(13), " %0a ") End Function تم تعديل يناير 7, 2023 بواسطه jjafferr لتنسيق الكود: استعمال <> القائمة ، ووضع الكود في نافذته
jjafferr قام بنشر يناير 7, 2023 قام بنشر يناير 7, 2023 اخوي حمدي 🙂 رجاء ضع الكود بهذه الطريقة ، حتى يظهر الكود بالطريقة الصحيحة: . . جعفر
حمدى الظابط قام بنشر يناير 7, 2023 الكاتب قام بنشر يناير 7, 2023 (معدل) 14 دقائق مضت, jjafferr said: اخوي حمدي 🙂 رجاء ضع الكود بهذه الطريقة ، حتى يظهر الكود بالطريقة الصحيحة: . . جعفر تم واشكرك للتنويه تم تعديل يناير 7, 2023 بواسطه حمدى الظابط
Moosak قام بنشر يناير 7, 2023 قام بنشر يناير 7, 2023 38 دقائق مضت, حمدى الظابط said: بيتم ارسال الرسالة مرتين لنفس الشخص أتوقع بسبب التعديلات المستمرة من أكثر من شخص .. الكود فيه تكرارات للأوامر لذلك هو يرسل أكثر من مرة 1
حمدى الظابط قام بنشر يناير 7, 2023 الكاتب قام بنشر يناير 7, 2023 (معدل) 11 دقائق مضت, Moosak said: أتوقع بسبب التعديلات المستمرة من أكثر من شخص .. الكود فيه تكرارات للأوامر لذلك هو يرسل أكثر من مرة الكود بين يديك عدل فيه كما تشاء حتى يعطى النتيجة النهائية واعلم ان الكود فى يد استاذ فاضل يعرف يطوع ما يشاء من اكواد تم تعديل يناير 7, 2023 بواسطه حمدى الظابط
qathi قام بنشر يناير 7, 2023 قام بنشر يناير 7, 2023 7 ساعات مضت, طاهر الوليدي said: انا اعمل على هده الفكره بارك الله فيك اخي طاهر ساقوم بتجربة الملف ياريت وتكتمل الأفكار نراقب اساتذتنا بتلهف تمنينا أن نشارك ولو بالقليل لكن تركنا الأمر لاساتذتنا .. فهم الاجدر بذلك 1
Moosak قام بنشر يناير 8, 2023 قام بنشر يناير 8, 2023 مجال الاجتهاد مفتوح للجميع 🙂 أنا مشغول جدا هذي الفترة .. 🌹 1
حمدى الظابط قام بنشر يناير 8, 2023 الكاتب قام بنشر يناير 8, 2023 6 ساعات مضت, Moosak said: مجال الاجتهاد مفتوح للجميع 🙂 أنا مشغول جدا هذي الفترة .. 🌹 الاستاذ موسى اشكرك على تعبك ومجهودك وربنا يعينك ويوفقك ويرزقك تقبل تحياتى وودى لشخصك الكريم up 1
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.