عند الارسال واتساب تظهر الرسالة متلاصقة

**حمدى الظابط** · يناير 7, 2023

السلام عليكم

الموضوع / ارسال رسالة نصية واتساب

التوضيح / عند ارسال الرسالة يجب كتابة اسم المرسل اولا فى سطر منفرد ثم الرسالة النصية ثانيا ثم ظهور المرفق ثالثا ثم عنوان الراسل رابعابسطر منفرد

المشكلة / ظهور كل مربعات النص متلاصقة بصورة غير واضحة كما فى الصورة المرفقة

المطلوب / تعريف مربعات النص للكود بصورة تظهر ما تم ذكره بصورة منسقة ومرتبه وواضحة

وكل الاحترام والتقدير للجميع

تجرية.rarFetching info...

تم تعديل يناير 7, 2023 بواسطه حمدى الظابط

**jjafferr** · يناير 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.

جعفر

**Moosak** · يناير 7, 2023

في 7‏/1‏/2023 at 06:10, jjafferr said:

في الواتساب ، للإنتقال للسطر التالي ، لا تستعمل vbcrlf او chr(10) او chr(13) ، وانما استعمل "%0a"

Expand

شكرا لك عمي جعفر ، كنت أعاني من هذي المشكلة وما عارف كيف أحلها .. 😅

والحين بعد ما عرفت .. عملت هذي الدالة لاستبدال فواصل الفقرات بالرمز "%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

**jjafferr** · يناير 7, 2023

في 7‏/1‏/2023 at 07:45, Moosak said:

جربتها في برنامج مرسال الواتسأب ونجحت ولله الحمد 😊

Expand

الحمدلله 🙂

جعفر

تم تعديل يناير 7, 2023 بواسطه jjafferr

**حمدى الظابط** · يناير 7, 2023

السلام عليكم

وحده وحده عليه علشان انا لسه تلميذ بيتعلم من اساتذته اطبق الكلام ده ازاى ومكانه فين فى الكود

**Moosak** · يناير 7, 2023

وعليكم السلام

في 7‏/1‏/2023 at 08:12, حمدى الظابط said:

اطبق الكلام ده ازاى ومكانه فين فى الكود

Expand

أستاذ حمدي .. في زر الارسال .. وقبل ما يشتغل الكود اللي يفتح الواتسأب .. تستبدل النص اللي حترسله ولنفرض أنه موجود في مربع النص Me.MsgText تستبدله بالنص الجديد اللي حتعطيك إياه الدالة اللي ذكرتها سابقا كما يلي :

تعرف متغير جديد اسمه MSG علشان تحفظ فيه النص المراد إرساله بعد الاستبدال هكذا :

Dim MSG as String
MSG = ReplaceLineBreaks(Me.MsgText)

وبعدها تخلي الواتسأب يرسل لك النص اللي متخزن في المتغير MSG .. 🙂

**حمدى الظابط** · يناير 7, 2023

في 7‏/1‏/2023 at 08:35, Moosak said:
وعليكم السلام

أستاذ حمدي .. في زر الارسال .. وقبل ما يشتغل الكود اللي يفتح الواتسأب .. تستبدل النص اللي حترسله ولنفرض أنه موجود في مربع النص Me.MsgText تستبدله بالنص الجديد اللي حتعطيك إياه الدالة اللي ذكرتها سابقا كما يلي :

تعرف متغير جديد اسمه MSG علشان تحفظ فيه النص المراد إرساله بعد الاستبدال هكذا :
Dim MSG as String
MSG = ReplaceLineBreaks(Me.MsgText)
وبعدها تخلي الواتسأب يرسل لك النص اللي متخزن في المتغير MSG .. 🙂
Expand

بعد التجربة حذفت Text عندما هر لى حطأ ثم ظهر لى هذا الخطأ كما فى الصورة

**Moosak** · يناير 7, 2023

في 7‏/1‏/2023 at 07:45, 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

Expand

أستاذ حمدي نسيت تشيل كود الدالة وتخليه في أي موديول عندك 🙂

وما دام مربع النص معاك اسمه MSG أيضا .. أفضل لك أن تغير اسم المتغير لاسم ثاني (strMSG) مثلا ... وذلك لتجنب حصول أخطاء في الكود

تم تعديل يناير 7, 2023 بواسطه Moosak

**حمدى الظابط** · يناير 7, 2023

في 7‏/1‏/2023 at 09:14, Moosak said:

أستاذ حمدي نسيت تشيل كود الدالة وتخليه في أي موديول عندك 🙂

وما دام مربع النص معاك اسمه MSG أيضا .. أفضل لك أن تغير اسم المتغير لاسم ثاني (strMSG) مثلا ... وذلك لتجنب حصول أخطاء في الكود

Expand

استاذى الفاضل الكريم هل ممكن تطبيق ذلك على الملف المرفق واكون شاكر جدا

**Moosak** · يناير 7, 2023

في 7‏/1‏/2023 at 09:24, حمدى الظابط said:

هل ممكن تطبيق ذلك على الملف المرفق

Expand

للأسف ما استطعت تشغيله .. يظهر لي أخطاء ولا يعمل ..

**حمدى الظابط** · يناير 7, 2023

في 7‏/1‏/2023 at 09:27, Moosak said:

للأسف ما استطعت تشغيله .. يظهر لي أخطاء ولا يعمل ..

Expand

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‏/1‏/2023 at 09:27, Moosak said:

للأسف ما استطعت تشغيله .. يظهر لي أخطاء ولا يعمل ..

Expand

اتفضل الملف بعد حذف كل المفاتيح التى ليس لها علاقة بعنوان الموضوع الموجود هو زر الارسال وزر ارفاق صورة للتجربة ولك جزيل الشكر والاحترام

تجرية.rarFetching info...

تم تعديل يناير 7, 2023 بواسطه حمدى الظابط

**Moosak** · يناير 7, 2023

غير هذا :

في 7‏/1‏/2023 at 09:38, حمدى الظابط 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"

Expand

إلى :

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"

وهذا :

في 7‏/1‏/2023 at 09:38, حمدى الظابط said:
objClipboard.SetText (Me.msg)
Expand

إلى :

objClipboard.SetText ReplaceLineBreaks(Me.msg)

**حمدى الظابط** · يناير 7, 2023

في 7‏/1‏/2023 at 09: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)

Expand

بعد التجربة وبعد الاحتفاظ بكود الدالة لم يتم الارسال

تم تعديل يناير 7, 2023 بواسطه حمدى الظابط

**qathi** · يناير 7, 2023

نريد أن نرى هذه الأفكار وغيرها في ملف

متكامل

وياريت إرسال النص مع صورة من الاكسس عبر الواتس

**طاهر الوليدي** · يناير 7, 2023

انا اعمل على هده الفكره

نموذجين لارسال وتساب وايميل.rarFetching info...

**Moosak** · يناير 7, 2023

في 7‏/1‏/2023 at 10:00, حمدى الظابط said:

وبعد الاحتفاظ بكود الدالة لم يتم الارسال

Expand

لا يزال البرنامج يخبرك أنك لم تضف الدالة التالية لبرنامجك 🙂 :

' =================================(وهذه دالة لجعل الواتسأب يقبل السطور الجديدة في النص المرسل)
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

في 7‏/1‏/2023 at 15:58, 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
أضفها في الأسفل تماما ( أسفل جميع الأكواد ) في نفس الصفحة مثلا .. وجرب من جديد
Expand

السلام عليكم

بعد التجربة النتيجة كما كانت بمرفق الموضوع بل بيتم ارسال الرسالة مرتين لنفس الشخص كما موجود فى الصورة وهذا هو الكود بعد التعديل تعبتك معايا ارجو قبول الاعتذار

  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

اخوي حمدي 🙂

رجاء ضع الكود بهذه الطريقة ، حتى يظهر الكود بالطريقة الصحيحة:

00.Code_01.jpg.a3a5081e47ec708645af3464eca96fda.jpg

.

00.Code_02.jpg.4c3118547d2083b42cd8c940306faefd.jpg

.

جعفر

**حمدى الظابط** · يناير 7, 2023

في 7‏/1‏/2023 at 19:17, jjafferr said:

اخوي حمدي 🙂

رجاء ضع الكود بهذه الطريقة ، حتى يظهر الكود بالطريقة الصحيحة:

.

.

جعفر

Expand

تم واشكرك للتنويه

تم تعديل يناير 7, 2023 بواسطه حمدى الظابط

**Moosak** · يناير 7, 2023

في 7‏/1‏/2023 at 18:56, حمدى الظابط said:

بيتم ارسال الرسالة مرتين لنفس الشخص

Expand

أتوقع بسبب التعديلات المستمرة من أكثر من شخص ..

الكود فيه تكرارات للأوامر لذلك هو يرسل أكثر من مرة

**حمدى الظابط** · يناير 7, 2023

في 7‏/1‏/2023 at 19:36, Moosak said:

أتوقع بسبب التعديلات المستمرة من أكثر من شخص ..

الكود فيه تكرارات للأوامر لذلك هو يرسل أكثر من مرة

Expand

الكود بين يديك عدل فيه كما تشاء حتى يعطى النتيجة النهائية واعلم ان الكود فى يد استاذ فاضل يعرف يطوع ما يشاء من اكواد

تم تعديل يناير 7, 2023 بواسطه حمدى الظابط

**qathi** · يناير 7, 2023

في 7‏/1‏/2023 at 12:37, طاهر الوليدي said:

انا اعمل على هده الفكره

Expand

بارك الله فيك اخي طاهر

ساقوم بتجربة الملف

ياريت وتكتمل الأفكار

نراقب اساتذتنا بتلهف

تمنينا أن نشارك ولو بالقليل

لكن تركنا الأمر لاساتذتنا .. فهم الاجدر بذلك

**Moosak** · يناير 8, 2023

مجال الاجتهاد مفتوح للجميع 🙂

أنا مشغول جدا هذي الفترة .. 🌹

**حمدى الظابط** · يناير 8, 2023

في 8‏/1‏/2023 at 10:33, Moosak said:

مجال الاجتهاد مفتوح للجميع 🙂

أنا مشغول جدا هذي الفترة .. 🌹

Expand

الاستاذ موسى اشكرك على تعبك ومجهودك وربنا يعينك ويوفقك ويرزقك تقبل تحياتى وودى لشخصك الكريم

up

تسجيل الدخول

عند الارسال واتساب تظهر الرسالة متلاصقة

الردود الموصى بها

حمدى الظابط

jjafferr

Moosak

jjafferr

حمدى الظابط

Moosak

حمدى الظابط

Moosak

حمدى الظابط

Moosak

حمدى الظابط

حمدى الظابط

Moosak

حمدى الظابط

qathi

طاهر الوليدي

Moosak

حمدى الظابط

jjafferr

حمدى الظابط

Moosak

حمدى الظابط

qathi

Moosak

حمدى الظابط

Join the conversation

تصفح هذا الموضوع مؤخراً 0 اعضاء متواجدين الان

تصفح الموقع

تصفح جديد الموقع

Support

Important Information