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

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

السلام عليكم

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

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

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

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

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

تجرية.rar

تم تعديل يناير 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

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

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

46 دقائق مضت, Moosak said:

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

الحمدلله 🙂

جعفر

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

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

السلام عليكم

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

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

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

16 دقائق مضت, حمدى الظابط said:

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

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

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

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

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

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

16 دقائق مضت, Moosak said:
وعليكم السلام

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

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

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

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

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

8 دقائق مضت, Moosak said:

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

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

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

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

1 دقيقه مضت, حمدى الظابط said:

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

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

**حمدى الظابط** · يناير 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

20 دقائق مضت, Moosak said:

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

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

تجرية.rar

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

**Moosak** · يناير 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)

**حمدى الظابط** · يناير 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

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

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

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

أضفها في الأسفل تماما ( أسفل جميع الأكواد ) في نفس الصفحة مثلا .. وجرب من جديد

**حمدى الظابط** · يناير 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

اخوي حمدي 🙂

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

00.Code_01.jpg.a3a5081e47ec708645af3464eca96fda.jpg

.

00.Code_02.jpg.4c3118547d2083b42cd8c940306faefd.jpg

.

جعفر

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

14 دقائق مضت, jjafferr said:

اخوي حمدي 🙂

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

.

.

جعفر

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

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

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

38 دقائق مضت, حمدى الظابط said:

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

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

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

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

11 دقائق مضت, Moosak said:

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

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

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

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

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

7 ساعات مضت, طاهر الوليدي said:

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

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

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

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

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

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

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

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

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

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

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

6 ساعات مضت, Moosak said:

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

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

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

up

تسجيل الدخول

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

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

حمدى الظابط

jjafferr

Moosak

jjafferr

حمدى الظابط

Moosak

حمدى الظابط

Moosak

حمدى الظابط

Moosak

حمدى الظابط

حمدى الظابط

Moosak

حمدى الظابط

qathi

طاهر الوليدي

Moosak

حمدى الظابط

jjafferr

حمدى الظابط

Moosak

حمدى الظابط

qathi

Moosak

حمدى الظابط

Join the conversation

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

تصفح الموقع

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

Support

Important Information