Moosak

وعليكم السلام ورحجمة الله وبركاته 🙂 استبدل هذه : بهذه : adad = CurrentProject.Path & "\" & Me.TextBoxName

شكرا لك أستاذنا العزيز @ابوخليل .. قلت كل اللي في نفسي أوصله للأستاذ حمدي 😄🌹 وإضافة إلى ذلك .. لديك الآن أكثر من موضوع في المنتدى تتكلم عن نفس القضية .. وهذا بدوره يسبب لنا ولك التشتت .. وكذلك إجابة من هنا وإجابة من هناك سببت أن الكود به تكرارات وأسطر ليس لها داعي والنتيجة بيتزا أكواد ما تجيب أي نتيجة .. 😁

أستاذ حمدي .. غيرت لك كود الإرسال بشكل كاااااااااااامل 🙂 (الكود الآن يتجاهل المرفقات إن كان حقل المرفقات فارغا ) وهذه نتيجة الإرسال : ملاحظة مهمة جدا جدا جدا : قمت بتعديلات أخرى على الملف غير كود الإرسال ، يجب عليك تعديلها ونقلها كلها في برنامجك وليس كود الإرسال فقط وذلك لكي تعمل لديك بشكل طبيعي . ومن هذه التعديلات ما يلي : أكواد ال API في الموديول FileOpen : #If VBA7 Then Public Declare PtrSafe Function GetOpenFileName Lib "comdlg32.dll" Alias _ "GetOpenFileNameA" (ofn As OPENFILENAME) As Boolean Public Declare PtrSafe Function GetSaveFileName Lib "comdlg32.dll" Alias _ "GetSaveFileNameA" (ofn As OPENFILENAME) As Boolean #Else Public Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _ "GetOpenFileNameA" (ofn As OPENFILENAME) As Boolean Public Declare Function GetSaveFileName Lib "comdlg32.dll" Alias _ "GetSaveFileNameA" (ofn As OPENFILENAME) As Boolean #End If #If VBA7 Then Public Declare PtrSafe Function SetForegroundWindow Lib "user32.dll" (ByVal hwnd As LongPtr) As LongPtr #Else Public Declare Function SetForegroundWindow Lib "user32.dll" (ByVal hwnd As Long) As Long #End If وفي الموديول 3 أيضا Module3 : #If VBA7 Then Private Declare PtrSafe Function LoadKeyboardLayout Lib "user32" Alias "LoadKeyboardLayoutA" (ByVal pwszKLID As String, ByVal flags As Long) As Long #Else Private Declare Function LoadKeyboardLayout Lib "user32" Alias "LoadKeyboardLayoutA" (ByVal pwszKLID As String, ByVal flags As Long) As Long #End If بالتوفيق 🙂 whatsapp-Moosak.rar

لا حول ولا قوة الا بالله العلي العظيم،،، لله ما أخذ وله ما أعطى وكل شيء عنده بأجل مسمى نسأل الله له الرحمة والمغفرة والثبات عند الحساب،، 🤲 عظم الله اجركم أخي العزيز أبا جودي

تفضل أخي العزيز 🙂 عدلت لك الدالة بحيث أنك تعطيها تاريخ البداية وتاريخ النهاية ورقم الأسبوع لكل مربع نص .. والدالة ترجع قيمة رقمية 0 و 1 ... الصفر يعني أن هذا الأسبوع ليس من ضمن نطاق الإجازة ، والواحد من ضمن نطاق الإجازة .. وبعدها بالتنسيق الشرطي تلون المربعات التي بها 1 .. ويمكنك إخفاء الأرقام بتلوينها نفس مربعات النص 🙂 وهذه هي الدالة : Public Function IsWeekIn(StartDate As Date, Enddate As Date, ThisIsWeekNumber As Integer) As Integer 'هذه الدالة تقوم بكتابة 1 في الأسابيع الواقعة بين تاريخين و 0 للتي ليست ضمن نطاق التواريخ المعطاه Dim WeekNumberForStartDate As Integer Dim WeekNumberForEndDate As Integer ' Assigning Week numbers for start and end days WeekNumberForStartDate = DatePart("ww", StartDate) WeekNumberForEndDate = DatePart("ww", Enddate) If ThisIsWeekNumber >= WeekNumberForStartDate And ThisIsWeekNumber <= WeekNumberForEndDate Then IsWeekIn = 1 Else IsWeekIn = 0 End If End Function وتكتبها كمصدر بيانات مربعات الأسبوع هكذا : =IsWeekIn([Strdate];[Enddate];1) لاحظ الرقم الأخير 1 هذا سيتغير لكل مربع من مربعات الأسابيع حسب رقم الأسبوع ( من 1 إلى 54 ) f6-Moosak.rar

وعليكم السلام ورحمة الله 🙂 حسب فهمي .. هذه دالة تعطيها تاريخين فتعطيك أرقام الأسابيع للتاريخ الأول والأخير والأسابيع الواقعة بينهما : Function ListWeekNumbers(startDate As Date, endDate As Date) As String Dim WeekNumberForStartDate As Integer Dim WeekNumberForEndDate As Integer Dim x As Integer ' Assigning Week numbers for start and end days WeekNumberForStartDate = DatePart("ww", startDate) WeekNumberForEndDate = DatePart("ww", endDate) ' Listing all the weeks numbers in between For x = WeekNumberForStartDate To WeekNumberForEndDate ListWeekNumbers = ListWeekNumbers & x & IIf(x <> WeekNumberForEndDate, ", ", "") Next 'Debug.Print ListWeekNumbers End Function وطريقة عملها هكذا ( من تاريخ اليوم حتى 3/5/2023 ): ListWeekNumbers(date , #5/3/2023# ) والناتج ( الأسابيع من 2 إلى 18 ) : 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18

يعتمد على طريقة تصميمك لصلاحيات المستخدمين .. ربما لو أرفقت ملفك لوجدت إجابة مباشرة لما تريد بدل أن تتلقى الكثير من الحلول التي لا تتوافق مع برنامجك 🙂 =================================================== بالنسبة لطريقتي أنا .. أكتب دالة خاصة لكل صلاحية من الصلاحيات وظيفتها أن تخبرني إن كان المستخدم الحالي يمتلك هذه الصلاحية أم لا .. وهذا شكلها : Public Function IsAdmin() As Boolean 'ترجع لك إذا كان المستخدم الحالي هو مدير البرنامج أو لا IsAdmin = Forms!LoginF!IsManager End Function هذه الدالة تعرف إن كنت مدير أو لا من نموذج تسجيل الدخول وترجع لي بقيمة True or False نعم أو لا .. بعد ذلك في حدث عند الفتح للتقرير أضع الكود هكذا ( لإظهار أو إخفاء الحقل المطلوب حسب الصلاحية التي يملكها المستخدم ) : Me.TextBoxName.Visible = IsAdmin لاحظ أن IsAdmin هو أسم الدالة السابقة وهي تعطيك True or False وهو ما يحدد هل سيظهر مربع النص أم سيختفي 🙂

شكرا لك دكتور جمال 🙂 🌹

تأكد من اسم العنصر أو الحقل .

أستاذ حمدي .. غير هذه إلى : strMSG = " || *" & Me.myname.Value & "*" & " ||" & vbcrlf & "|| *" & Me.msg.Value & "*" & " ||" & vbcrlf & "|| *" & Me.attach.Value & "* ||" & vbcrlf & "|| " & "المرسل : *" & Me.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 أضفها في الأسفل تماما ( أسفل جميع الأكواد ) في نفس الصفحة مثلا .. وجرب من جديد

أخي أحمد .. تجنب تسمية حقول الجدول بأرقام فقط .. أو أسماء تبدأ بأرقام .. تسبب لك مشاكل 🙂 أنا أضفت "c" قبل رقم كل حقل وعدلت الكود قليلا .. وشغال زي العسل .. Me.الراتب = DLookup("c" & Me.a2, "Degree", "GradeNO=" & Me.a1) وأعتقد كان شغل الأستاذ أبو أحمد مضبوط بعد 🙂👌🏼

غير هذا : إلى : 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)

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

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

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

شكرا لك عمي جعفر ، كنت أعاني من هذي المشكلة وما عارف كيف أحلها .. 😅 والحين بعد ما عرفت .. عملت هذي الدالة لاستبدال فواصل الفقرات بالرمز "%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) جربتها في برنامج مرسال الواتسأب ونجحت ولله الحمد 😊

من الصور لاحظت أن هناك فقرتين قبل الفقرة التي تبدأ برقم .. والكود يفحص دائما الفقرة الثانية .. 🙂 في هذي الحالة الكود يحتاج إلى تعديل ليبحث عن أول فقرة تبدأ برقم .. وربما يمكن الاستعانة بالأكواد السابقة لتحقيق ذلك .. والموجودة في هذا الموضوع :

وإذا أحببت أن تجعله كروتين منفصل لتناديه في وسط أكوادك السابقة حولته لك هكذا : Sub SelectText(ctrlTextBox As TextBox) ' Declare variables Dim TxtBoxControl As TextBox Dim txt As String Dim i As Integer Dim start As Integer Dim iEnd As Integer ' Defined The text box Set TxtBoxControl = ctrlTextBox ' Get the text from the text box txt = TxtBoxControl.Value ' Find the start of the first paragraph start = 0 ' Find the end of the first paragraph iEnd = InStr(1, txt, vbCrLf) 'Debug.Print iEnd ' Check if a paragraph break was found If iEnd > 0 Then ' Check if the next character after the paragraph break is a number 'Debug.Print "(" & Mid(txt, iEnd + 2, 1) & ")" If IsNumeric(Mid(txt, iEnd + 2, 1)) Then ' Select the text from the start of the first paragraph to the start of the second paragraph TxtBoxControl.SetFocus TxtBoxControl.SelStart = start TxtBoxControl.SelLength = iEnd - start End If End If Set TxtBoxControl = Nothing End Sub والآن يمكنك مناداته في كودك هكذا : Call SelectText(Me.nass2) فيقوم بعملية التحديد 🙂

بالفعل كان لا يعمل وبحاجة إلى تعديلات بسيطة 😁 وهذا هو الكود المعدل : Private Sub SelectBtn_Click() ' Declare variables Dim TxtBoxControl As TextBox Dim txt As String Dim i As Integer Dim start As Integer Dim iEnd As Integer ' Defined The text box Set TxtBoxControl = Me.nass2 ' Get the text from the text box txt = TxtBoxControl.Value ' Find the start of the first paragraph start = 0 ' Find the end of the first paragraph iEnd = InStr(1, txt, vbCrLf) 'Debug.Print iEnd ' Check if a paragraph break was found If iEnd > 0 Then ' Check if the next character after the paragraph break is a number 'Debug.Print "(" & Mid(txt, iEnd + 2, 1) & ")" If IsNumeric(Mid(txt, iEnd + 2, 1)) Then ' Select the text from the start of the first paragraph to the start of the second paragraph TxtBoxControl.SetFocus TxtBoxControl.SelStart = start TxtBoxControl.SelLength = iEnd - start End If End If Set TxtBoxControl = Nothing End Sub وضعته على زر .. وكتبت اسم مربع النص في أول الكود وهذه هي النتيجة : 🙂

وعليكم السلام ورحمة الله وبركاته 🙂 بالذكاء الاصطناعي .. ولم أجربه بعد 😅 وظيفة الكود فقط التركيز على المربع النص المطلوب ثم تحديد النص من أول الفقرة وحتى أول فقرة تبدأ برقم .. ( حسب الوصف الذي أعطيته إياه ) جربه وأخبرنا بالنتيجة 🙂 Sub SelectText() ' Declare variables Dim txt As String Dim i As Integer Dim start As Integer Dim end As Integer ' Get the text from the text box txt = Me.TextBox1.Value ' Find the start of the first paragraph start = 1 ' Find the end of the first paragraph end = InStr(start, txt, vbCrLf) ' Check if a paragraph break was found If end > 0 Then ' Check if the next character after the paragraph break is a number If IsNumeric(Mid(txt, end + 1, 1)) Then ' Select the text from the start of the first paragraph to the start of the second paragraph Me.TextBox1.SetFocus Me.TextBox1.SelStart = start Me.TextBox1.SelLength = end - start End If End If End Sub

أعتقد أنك تقصد هذا الموضوع 🙂 :

الحمدلله جربته والأمور طيبة 🙂 فقط بقي إضافة تنبيهات التحقق من تعبئة جميع الحقول الأساسية مثل ( المبلغ - عدد الأقساط - تاريخ البداية - .... ) لأنها قد تعطي نتائج خاطئة أو رسائل خطأ .. 🙂