نجوم المشاركات

اعرض الملف إمنح تطبيقك المظهر الإحترافي بإستخدام مربع حوار المهام بديل لـ MsgBox {سلسلة الأدوات المساعدة المخصصة} أرفق لك إحدى الأدوات الرائعة التي يمكن أن تغنيك عن الكثير من النماذج وتجعل رسائل التنبيه تشبه رسائل ويندوز حاولت قد الإمكان تبسيط طريقة الإستخدام وتوضيحها في التعليقات أرجو أن تنال إعجابكم مع تحياتي صاحب الملف منتصر الانسي تمت الاضافه 07/05/25 الاقسام قسم الأكسيس  

السلام عليكم ورحمة الله وبركاته حياكم الله جميعا عذرا اخي المفتاح الرئيسي صحيح ولا يوجد مشكلة فيه كانت المشكلة في نوع البيانات، كانت هناك بيانات نوعها رقم كبير وكانت خصائص قاعدة البيانات لا تسمح برقم كبير ، وعندما فعلت هذا الخيار ظهرت الجداول بشكل صحيح

أخواني وأساتذتي ومعلمينا ( دون استثناء ) أعتقد أنه ومن خلال العنوان سيتسائل البعض عن أن المحاولات كانت كثيرة لبناء هذه الفكرة ولكنها مع التحديثات الجديدة تفشل !! وهذا الإعتقاد منطقي 😁 . إلا انه وبهذه التحديثات - واتمنى - أنه قد تم التعامل مع هذه الأخطاء بهذه النسخة المطورة والمحسنة . الإضافات التي تم تأمينها في هذه النسخة :- التعامل مع المرفقات بسلاسة وسهولة من خلال فكرة نسخ المرفق ولصقه في تطبيق الواتس اب ( سطح المكتب ) ، وليس من خلال المسار 😁 . إمكانية الإرسال لأكثر من رقم دفعة واحدة . افصل بين الرقمين بإشارة / فقط . إمكانية إضافة التعبيرات Emoji وإرسالها ضمن الرسائل في الواتس أب . من خلال زر زر لمسح محتوى الرسالة تهيئةً لإرسال جديد . من خلال الزر تضمين محدد لحجم الملفات والمرفقات المرسلة . ( خاص بأصحاب التطويرات الذين يريدون تقييد وإلزام المستخدم بحجم محدد ) . استخدام تايمر متغير للتعامل مع الإرسالات المتعددة لأكثر من رقم . واجهة محاكية وجذابة للبرنامج . لا تحتاج جداول أو مكتبات خارجية .... إلخ . تم كتابة الدوال والأكواد بطريقة تسهل على المطورين إعادة الهيكلة والتصميم حسب حاجتهم في برامجهم . واجهة البرنامج :- :- ضرورة تثبيت برنامج واتس اب سطح المكتب من متجر ويندوز . التأكد من فتح تطبيق الواتس أب سطح المكتب لديك ، لتلافي المشاكل عند اختلاف سرعة إستجابة الكمبيوتر من مستخدم لآخر . WhatsApp Sender 2025.zip التحديث الجديد من مرسال الواتس أب - الإصدار الثاني . يحتوي على الإضافات والتحسينات التالية :- 1️⃣ التحسينات :- تحسين التعامل مع المرفقات الأكثر من مرفق واحد ، بحيث يتم التعامل معها دفعة واحدة بدلاً من التعامل مع كل مرفق بشكل مستقل ( تقليل الوقت ) . تحسين عمليات المحاكاة للوحة المفاتيح للصق الرسالة والملفات داخل تطبيق واتس أب سطح المكتب . 2️⃣ الإضافات الجديدة :- إنشاء جداول الخدمة ( عددها 3 ) بشكل تلقائي . إضافة ميزة الإستيراد من ملفات VCF ( النسخة الإحتياطية من قائمة الأسماء من الجوال ) . بحيث يتم استيراد الأرقام والأسماء الى جدول Tbl_Contacts ، من خلال زر ، مع دعم التعامل مع الترميزات والتشفيرات المختلفة . وأيضاً الأرقام يتم تحويلها إلى صيغة دولية تلقائيًا (مثلاً: 079xxxx → +96279xxxx) . إضافة ميزة إنشاء جهة اتصال جديدة ( قيد التطوير للأفضل ) ، من خلال الزر . إضافة ميزة "إرفاق التوقيع مع الرسالة" . ويمكن التحكم بها من خلال جدول الإعدادات Tbl_SendSettings . إضافة ميزة الإرسال من دفتر العناوين ( متعدد الإختيار ) ، أو ادخال رقم هاتف بشكل يدوي . عند ادخال رقم هاتف يدوي ( محلي ) بدون مفتاح الدولة ، يتم قراءة قيمة رمز الدولة الإفتراضي من الجدول Tbl_SendSettings الخاص بالإعدادات . وعليه فسلت بحاجة لإضافة مفتاح الدولة المحلية بشكل يدوي وإلزامي . إضافة ميزة تقييد مفتاح الإيموجي من خلال جدول الإعدادات . فمنح أو رفض الصلاحية بالوصول اليه . ( قيد التطوير بحيث يتم المنع حتى من خلال لوحة المفاتيح ) . إضافة ميزة تحديد أنواع الملفات المسموح للمستخدم بإرسالها في جدول الإعدادات نفسه . إضاقة التحكم بفترة الإنتظار بين الرسالتين عند الإرسال المتعدد ( بالثواني - القيمة الإفتراضية = 2 ) . إضافة ميزة التحكم بالحد الأقصى لحجم الملفات المرفقة ( فردي أو أكثر من مرفق ) من خلال جدول الإعدادات أيضاً . إضافة رابط لتحميل نسخة برنامج واتس أب سطح المكتب من مصدره على موقع Whatsapp ، من خلال الزر . إضافة ميزة الحفظ التلقائي للأرقام الغير مخزنة في دليل الهاتف ( الجدول Tbl_Contacts ) . بحيث يتم تعريف الرقم بأنه "غير معروف" . وفي التعديلات اللاحقة سيتم إضافة ميزات لها . جميع الرسائل المرسلة ( الناجحة والغير ناجحة ) سيتم تخزينها في الجدول Tbl_Message . أيضاً في التعديلات اللاحقة سيتم إضافة ميزات لها . :- دعوة لتجربة الإستيراد من ملفات الـ VCF ، وإخباري بالنتيجة عن مدى صحة الإستيراد . السبب في سؤالي هذا هو اختلاف إصدارات هذه الملفات الناتجة عن اختلاف إصدارات أنظمة التشغيل في الهاتف الخلوي ، أو اختلاف الحصول عليها حسب البرنامج . وللعلم الـ VCF هي ملفات تستخدم لتخزين معلومات جهات الاتصال . كيف نحصل عليها :- في الأندرويد : الذهاب إلى تطبيق جهات الاتصال ثم الإعدادات ثم ابحث عن استيراد و تصدير جهات الإتصال ثم حفظ كملف VCF . في الآيفون : لا يدعم آيفون هذه الميزة ( تصدير جهات الإتصال ) إلا من خلال تطبيقات كمبيوتر مثل 3UTools وشبيهاته . 3️⃣ صور الواجهة الجديدة :- 4️⃣ تحميل الإصدار الجديد :- WhatsApp Sender 2025 V2.0.zip 😬 يوجد سطر لم أقم بحذفه سهواً أثناء التعديلات في دالة الإستيراد الرئيسية من المديول في الدالة Public Function ImportVCF . السطر :- Forms("Frm_Sender").Controls("Text0").Requery حيث أن هذا العنصر تم الإستغناء عنه . ومرفق في طيه ملف VCF تجريبي للتجربة Test VCF.zip WhatsApp Sender - V4.0.accdb.zip

وعليكم السلام ورحمة الله وبركاته .. كمشاركة أولى بدون دالة ، وتتكون من 3 أشكال متدرجة ، الإستعلام الأول :- SELECT c.UserId, c.chekIn, c.chekOut, IIf( TimeValue(c.chekIn) > DateAdd("n", f.start_free, f.start_work), DateDiff("n", DateAdd("n", f.start_free, f.start_work), TimeValue(c.chekIn)), 0 ) AS In_Loss, IIf( TimeValue(c.chekOut) < DateAdd("n", -f.end_free, f.end_work), DateDiff("n", TimeValue(c.chekOut), DateAdd("n", -f.end_free, f.end_work)), 0 ) AS out_Loss, Format( IIf( TimeValue(c.chekIn) > DateAdd("n", f.start_free, f.start_work) OR TimeValue(c.chekOut) < DateAdd("n", -f.end_free, f.end_work), DateDiff("n", IIf(TimeValue(c.chekIn) > DateAdd("n", f.start_free, f.start_work), TimeValue(c.chekIn), DateAdd("n", f.start_free, f.start_work) ), IIf(TimeValue(c.chekOut) < DateAdd("n", -f.end_free, f.end_work), TimeValue(c.chekOut), DateAdd("n", -f.end_free, f.end_work) ) ) / 1440.0, f.countWorkHours ), "hh:nn" ) AS work_Hours_count FROM tblcomIn AS c, tbl_Ftrat AS f WHERE f.ftraName = 'الفترة الرئيسية' ORDER BY c.UserId, c.chekIn; Query2 UserId chekIn chekOut In_Loss out_Loss work_Hours_count 1111 2025-07-05 3:50:10 PM 2025-07-05 11:50:12 PM 0 0 07:30 2222 2025-07-05 4:20:16 PM 2025-07-05 11:20:28 PM 0 0 07:30 3333 2025-07-05 4:32:20 PM 2025-07-05 11:28:31 PM 2 0 06:28 4444 2025-07-05 5:01:25 PM 2025-07-05 11:32:34 PM 31 0 05:59 الإستعلام الثاني :- SELECT c.UserId, c.chekIn, c.chekOut, IIf(TimeValue(c.chekIn)>DateAdd("n",f.start_free,f.start_work),DateDiff("n",DateAdd("n",f.start_free,f.start_work),TimeValue(c.chekIn)),0) AS In_Loss, IIf(TimeValue(c.chekOut)<DateAdd("n",-f.end_free,f.end_work),DateDiff("n",TimeValue(c.chekOut),DateAdd("n",-f.end_free,f.end_work)),0) AS out_Loss, Format(IIf(TimeValue(c.chekIn)>DateAdd("n",f.start_free,f.start_work) Or TimeValue(c.chekOut)<DateAdd("n",-f.end_free,f.end_work),DateDiff("n",IIf(TimeValue(c.chekIn)>DateAdd("n",f.start_free,f.start_work),TimeValue(c.chekIn),DateAdd("n",f.start_free,f.start_work)),IIf(TimeValue(c.chekOut)<DateAdd("n",-f.end_free,f.end_work),TimeValue(c.chekOut),DateAdd("n",-f.end_free,f.end_work)))/1440,f.countWorkHours),"Short Time") AS work_Hours_count, 'التفاصيل: ' & IIf(TimeValue(c.chekIn)>DateAdd("n",f.start_free,f.start_work),'تأخر ' & DateDiff("n",DateAdd("n",f.start_free,f.start_work),TimeValue(c.chekIn)) & ' دقيقة','حضور في الموعد') & ' - ' & IIf(TimeValue(c.chekOut)<DateAdd("n",-f.end_free,f.end_work),'انصراف مبكر ' & DateDiff("n",TimeValue(c.chekOut),DateAdd("n",-f.end_free,f.end_work)) & ' دقيقة','انصراف في الموعد') AS Details FROM tblcomIn AS c, tbl_Ftrat AS f WHERE (((f.ftraName)='الفترة الرئيسية') And ((DateValue(c.chekIn))=#7/5/2025#)) ORDER BY c.UserId; Query3 UserId chekIn chekOut In_Loss out_Loss work_Hours_count Details 1111 2025-07-05 3:50:10 PM 2025-07-05 11:50:12 PM 0 0 07:30 التفاصيل: حضور في الموعد - انصراف في الموعد 2222 2025-07-05 4:20:16 PM 2025-07-05 11:20:28 PM 0 0 07:30 التفاصيل: حضور في الموعد - انصراف في الموعد 3333 2025-07-05 4:32:20 PM 2025-07-05 11:28:31 PM 2 0 06:28 التفاصيل: تأخر 2 دقيقة - انصراف في الموعد 4444 2025-07-05 5:01:25 PM 2025-07-05 11:32:34 PM 31 0 05:59 التفاصيل: تأخر 31 دقيقة - انصراف في الموعد الإستعلام الثالث :- SELECT c.UserId, c.chekIn, c.chekOut, IIf(TimeValue(c.chekIn)>DateAdd("n",f.start_free,f.start_work),DateDiff("n",DateAdd("n",f.start_free,f.start_work),TimeValue(c.chekIn)),0) AS In_Loss, IIf(TimeValue(c.chekOut)<DateAdd("n",-f.end_free,f.end_work),DateDiff("n",TimeValue(c.chekOut),DateAdd("n",-f.end_free,f.end_work)),0) AS out_Loss, Format(DateDiff("n",IIf(TimeValue(c.chekIn)<f.start_work,f.start_work,TimeValue(c.chekIn)),IIf(TimeValue(c.chekOut)>f.end_work,f.end_work,TimeValue(c.chekOut)))/1440,"Short Time") AS work_Hours_count, 'التفاصيل: ' & IIf(TimeValue(c.chekIn)>DateAdd("n",f.start_free,f.start_work),'تأخر ' & DateDiff("n",DateAdd("n",f.start_free,f.start_work),TimeValue(c.chekIn)) & ' دقيقة',IIf(TimeValue(c.chekIn)<f.start_work,'حضور مبكر ' & DateDiff("n",TimeValue(c.chekIn),f.start_work) & ' دقيقة','حضور في الموعد')) & ' - ' & IIf(TimeValue(c.chekOut)<DateAdd("n",-f.end_free,f.end_work),'انصراف مبكر ' & DateDiff("n",TimeValue(c.chekOut),DateAdd("n",-f.end_free,f.end_work)) & ' دقيقة',IIf(TimeValue(c.chekOut)>f.end_work,'انصراف متأخر ' & DateDiff("n",f.end_work,TimeValue(c.chekOut)) & ' دقيقة','انصراف في الموعد')) AS Details FROM tblcomIn AS c, tbl_Ftrat AS f WHERE (((f.ftraName)='الفترة الرئيسية') And ((DateValue(c.chekIn))=#7/5/2025#)) ORDER BY c.UserId; Query4 UserId chekIn chekOut In_Loss out_Loss work_Hours_count Details 1111 2025-07-05 3:50:10 PM 2025-07-05 11:50:12 PM 0 0 07:30 التفاصيل: حضور مبكر 10 دقيقة - انصراف متأخر 20 دقيقة 2222 2025-07-05 4:20:16 PM 2025-07-05 11:20:28 PM 0 0 07:00 التفاصيل: حضور في الموعد - انصراف في الموعد 3333 2025-07-05 4:32:20 PM 2025-07-05 11:28:31 PM 2 0 06:56 التفاصيل: تأخر 2 دقيقة - انصراف في الموعد 4444 2025-07-05 5:01:25 PM 2025-07-05 11:32:34 PM 31 0 06:29 التفاصيل: تأخر 31 دقيقة - انصراف متأخر 2 دقيقة data1.zip أم تفضل استخدام دالة 😁 .. ؟

اتمنى أن يكون مساعدا وملهماً للأفكار الجديدة فهذا أهم الأسباب لقيامي بالعمل على هذه السلسلة بالإضافة لما تكرمت به أعتقد أيضا أنه سيغنينا عن إنشاء نماذج التحكم (النماذج التي لاتستخدم لإدخال البيانات) مثل نماذج تحديد معايير التقارير والإستعلامات وغيرها من النماذج

عمل جميل ، ويحتاجه مصممي البرامج والذين يريدون تغيير نمط الرسائل .. جزاكم الله خيراً على هذه الأفكار الجميلة

بعد التجربة المطولة شغال بامتياز وعلى أكمل وجه والله لا تكفي الكلمات لشكرك اسال الله أن ييسر أمورك و يرزقك من حيث لا تحتسب جزاك الله كل خير أخي الكريم @Foksh

بعد تفحص الملف على السريع احب اقول لك بارك الله فيك ده ملف مهم جدا ويفتح مجال فى طريقة التفكير بارك الله فيك وفى علمك وجزاك الله خير الجزاء

تفضل أخي الكريم .. baseM.zip

التحديث الجديد يستحق الإنتظار 🤗

أخي الكريم ، على حسب ما فهمت من كلامك ، انظر التعديلات التالية :- المديول :- Public Function GetTxtHeight(annee As String, grade As String, wilaya As String, ByRef rapport As String) As Single Dim db As DAO.Database Dim rs As DAO.Recordset Dim hauteur As Single Set db = CurrentDb Set rs = db.OpenRecordset( _ "SELECT hauteur_rang, nom_raport FROM tab_hauteur_range " & _ "WHERE annee = '" & Replace(Trim(annee), "'", "''") & "' " & _ "AND grade = '" & Replace(Trim(grade), "'", "''") & "' " & _ "AND wilaya = '" & Replace(Trim(wilaya), "'", "''") & "'", dbOpenSnapshot) If Not rs.EOF Then hauteur = Nz(rs!hauteur_rang, 0) * 567 rapport = Nz(rs!nom_raport, "") Else hauteur = 0.7 * 567 rapport = "" End If rs.Close: Set rs = Nothing: Set db = Nothing GetTxtHeight = hauteur End Function حدث الزر :- Private Sub أمر2_Click() Dim h As Single Dim rapport As String h = GetTxtHeight(Me.annet, Me.grade1, Me.wilaya1, rapport) TempVars!Temp_Hauteur = h If rapport <> "" Then DoCmd.OpenReport rapport, acViewPreview Else MsgBox ". لم يتم العثور على تقرير مطابق", vbInformation + vbMsgBoxRight, "" End If End Sub حدث فتح التقرير :- Private Sub Report_Open(Cancel As Integer) Dim h As Single Dim ctrl As Control h = Nz(TempVars!Temp_Hauteur, 0.7 * 567) For Each ctrl In Me.Controls If ctrl.ControlType = acTextBox Then If LCase(Trim(Nz(ctrl.Tag, ""))) = "moho58" Then ctrl.Height = h End If End If Next ctrl End Sub لاحظ اننا اعتمدنا على Tag = moho58 لمربعات النص التي نريد التنفيذ عليها ، دون الحاجة الى تحديد الأسماء بشكل يدوي .. الملف :- baseM.zip

ارفق ملف يحتوي أكثر من شرط أخي الكريم ، مع العلم ان ارتفاع جزء التفاصيل سيكون حسب ارتفاع المربعات النصية !!!!!!

وعليكم السلام ورحمة الله وبركاته ,, كفكرة بسيطة ، في مديول جديد ، استعمل الدالة التالية :- Public Function GetTxtHeight(annee As String, grade As String, wilaya As String, nomRapport As String) As Single Dim db As DAO.Database Dim rs As DAO.Recordset Dim hauteur As Single Set db = CurrentDb Set rs = db.OpenRecordset( _ "SELECT hauteur_rang FROM tab_hauteur_range " & _ "WHERE annee = '" & annee & "' " & _ "AND grade = '" & grade & "' " & _ "AND wilaya = '" & wilaya & "' " & _ "AND nom_raport = '" & nomRapport & "'", dbOpenSnapshot) If Not rs.EOF Then hauteur = rs!hauteur_rang * 567 Else hauteur = 0.7 * 567 End If rs.Close: Set rs = Nothing: Set db = Nothing GetTxtHeight = hauteur End Function ثم في حدث الزر عند التقر لفتح التقرير :- Private Sub أمر2_Click() Dim h As Single Dim annee As String, grade As String, wilaya As String, rapport As String rapport = "rap_pv" annee = Me.annee grade = Me.grade1 wilaya = Me.wilaya1 h = GetTxtHeight(annee, grade, wilaya, rapport) TempVars!Temp_Hauteur = h DoCmd.OpenReport rapport, acViewPreview End Sub وفي حدث عند الفتح للتقرير :- Private Sub Report_Open(Cancel As Integer) Dim h As Single If Not IsNull(TempVars!Temp_Hauteur) Then h = TempVars!Temp_Hauteur Else h = 0.7 * 567 End If Me.nom.Height = h Me.prenom.Height = h End Sub مع ضرورة عدم تمكين لمربعي النص ( nom و prenom ) مع العلم ان الفكرة قابلة للتطوير بالتحكم بحجم الخط أيضاً 😉 الملف :- baseM.zip

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

الأخوة الكرام أسعد الله مساءكم ووفقكم لك خير تحديث جديد يتضمن بعض التعديلات علي نموذج الـ html وهي 1- تم إضافة ميزة البحث بقيم متعدده يفصل بينهم | أو ; أو , وهذا في البحث العام او الحث الخاص بكل نموذج (2) 3- ميزة نسخ كامل محتوي العمود مع أمكانية أختيار الفاصل بينهم او كتابة فاصل جديد (4) وأيضاً اختيار ضم عنوان العمود أم لا (5) 6- تم معالجة بعض القيم لعرض أفضل 7- تم تحسين طريقة نسخ محتوي الخلية للتناسب مع الخلية التي تحمل رابط بداخلها صوره لبعض النتائج بالتوفيق Ahmos_AutoHtmlTable_V1.1_Files.zip

بسيطة أخي الكريم .. تم التعديل الى الكود التالي :- Private Sub ListBox1_Click() If ListBox1.ListIndex = -1 Then Exit Sub Sheets(ListBox1.Column(0)).Activate Cells.Interior.Pattern = xlNone With Range(ListBox1.Column(1)).EntireRow .Interior.Color = vbYellow .Cells(1, 1).Activate End With TextBox2.Value = ListBox1.Column(2) End Sub

بارك الله فيك وجعله بميزان حسناتك