اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

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


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

السلام عليكم 

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

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

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

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

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

‏‏لقطة الشاشة (11).png

تجرية.rar

تم تعديل بواسطه حمدى الظابط
رابط هذا التعليق
شارك

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

 

في الواتساب ، للإنتقال للسطر التالي ، لا تستعمل 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.

 

جعفر

  • Like 2
  • Thanks 1
رابط هذا التعليق
شارك

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)

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

تم تعديل بواسطه Moosak
  • Like 2
  • Thanks 1
رابط هذا التعليق
شارك

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

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

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

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

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

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

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

  • Like 1
رابط هذا التعليق
شارك

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

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

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

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

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

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

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

‏‏لقطة الشاشة (12).png

رابط هذا التعليق
شارك

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) مثلا ... وذلك لتجنب حصول أخطاء في الكود

تم تعديل بواسطه Moosak
  • Like 1
رابط هذا التعليق
شارك

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

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

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

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

رابط هذا التعليق
شارك

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

 

تم تعديل بواسطه jjafferr
لتنسيق الكود: استعمال <> القائمة ، ووضع الكود في نافذته
رابط هذا التعليق
شارك

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

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

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

تجرية.rar

تم تعديل بواسطه حمدى الظابط
رابط هذا التعليق
شارك

غير هذا :

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)

 

  • Like 1
رابط هذا التعليق
شارك

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)

 

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

 

‏‏لقطة الشاشة (14).png

تم تعديل بواسطه حمدى الظابط
رابط هذا التعليق
شارك

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

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

  • Like 1
رابط هذا التعليق
شارك

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

 

 

 

‏‏لقطة الشاشة (16).png

تم تعديل بواسطه jjafferr
لتنسيق الكود: استعمال <> القائمة ، ووضع الكود في نافذته
رابط هذا التعليق
شارك

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

اخوي حمدي 🙂

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

00.Code_01.jpg.a3a5081e47ec708645af3464eca96fda.jpg

.

00.Code_02.jpg.4c3118547d2083b42cd8c940306faefd.jpg

.

جعفر

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

تم تعديل بواسطه حمدى الظابط
رابط هذا التعليق
شارك

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

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

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

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

  • Like 1
رابط هذا التعليق
شارك

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

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

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

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

 

 

تم تعديل بواسطه حمدى الظابط
رابط هذا التعليق
شارك

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

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

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

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

 

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

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

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

 

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

  • Like 1
رابط هذا التعليق
شارك

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

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

 

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

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

up

  • Thanks 1
رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

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

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information