Moosak

وهنا كود مربع الإدخال Input Box على شكل نجوم .. من عند نجوم المنتدى 🙂 :

ما اعطيتني رقم الباسوورد مال الجماعة مالك علشان أشبك معاك على طول 😁 جالس أطور مشروع تحديث ال FE التلقائي ونجحت العملية ولله الحمد .. بحاول أنزله قريبا إن شاء الله .. 😊

هذا خط كوفي .. وهذا أقرب مثال وجدته للخط المكتوب عندك 🙂 https://arbfonts.com/mcs-shafa-e-u-normal-font-download.html?preview=صورة+قيد+مقفل واطلع على هذه أيضا : https://arbfonts.com/mcs-shafa-s-u-normal-font-download.html https://arbfonts.com/alawi-shafa-font-download.html https://arbfonts.com/mcs-shafa-e-i-normal-font-download.html التحميل من نفس الصفحات 🙂

ممتاز جدا عمي جعفر .. 🙂 هذا يحل مشكلة ملفات الباتش وال Dos أيضا التي لا تتعامل مع اللغة العربية 🌹 كنت أعاني شخصيا من هذي المشكلة وما عارف كيف أحلها .. ولما خلصت ووجدت البديل جاء الفرج 😅

ما الذي كتبته في الحقل النصي ؟ الرابط كاملا أم أسم الملف فقط ؟ إن كنت ستكتب الرابط كاملا فالتعديل سكون هكذا ؟

العفو أخي حمدي .. تحياتي لك 🙂🌹

بعد مراجعة الكود وجدت أن rs.MoveNext متكررة مرتين .. أحذف الأولى حسب الصورة التالية :

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

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