Foksh

بارك الله بكم استاذي الفاضل 😇.. شكراً لك 💐

ماذا لو حصل خلل أو انقطاع الكهرباء أو تلف ... الخ !!!! رغم أنك وأعتقد ذلك من خلال المكتبات أنك أسست للربط بجهاز البصمة ، فهل الخلل الحاصل سيتحمله الموظف ويدخل في متاهة أثبت أو إحلف 😅 ..... الخ. ما لم تكن هناك حلول لهذه الإحتمالات قد تم أخذها في الحسبان ، فرأيي أن الأنظمة التي يقود مركبها جهاز قابل للخطأ = غير عادلة. أشعر انني انفعلت قليلاً 🤣😂 هي وجهة نظر ما لم يكن معلمي قد خبأ لنا إجابة تنتظر هذا التعليق . الأكواد جميلة جدا ، وفكرتها جميلة وقد ألمت بجميع النواحي البرمجية التي تحدثتم عنها سابقاً.

الحمد لله على نعمه.. لا تنسى إغلاق الموضوع أخي الكريم 🤗

حبيبي يا هندسة 🤗 اللهم تقبل دعائكم بظهر الغيب 🤲🏻 شكراً لمرورك اختنا الكريمة ،، ولكم من الدعاء النصيب الأكبر 😇

وإياكم أخي الكريم .. شكراً لمرورك العطر

كثيرون استفسروا عن كيفية اختيار اسم مخزن في الجدول ، بدلاً من كتابة الرقم بشكل يدوي . ولذا قد صورت هذا الفيديو كفكرة سريعة على الخطوات - وصولاً إلى النتيجة ,, طبعاً كلمة كثيرون = في مجموعة الواتس أب الخاصة بقسم آكسيس وليس في المنتدى 🤣

وعليكم السلام ورحمة الله وبركاته ،، وبما اني اتابع من الجوال ، ولم استطع من رؤية الملف . اعتقد ان هناك أكثر من فكرة !!! الأولى قد تعتمد على دالة تتفقد جميع العناصر ذات النوع "مربع نص" بأنها تحتوي قيم وغير فارغة . وهذا قد يسبب مشكلة لأنه حينها لن يميز بين مربعات النص التي تريدها من مربعات نص أخرى على سبيل المثال . الثانية أنه عند الحفظ وقبل إتمام عملية الحفظ التأكد من مربعات النص التي لها مصدر بيانات مرتبط بحقل وليس مربعات النص الغير مضمنة بمصدر بيانات ، وهنا قد تكون مشكلة أيضاً . الثالثة وما أرجحها بشكل أفضل وأقوى ، وهو من خلال الـ TAG . بحيث تضع وسماً لجميع مربعات النص التي تريدها أن يتم التحقق منها ولنفترض = Ham حيث من خلال زر الحفظ نستعمل كود بهذا الشكل تقريباً - ما لم أكن مخطئاً في بعض الأجزاء .. dim ctl as control, missing as string for each ctl in me.controls if lcase(trim(ctl.tag)) = "Ham" then if nz(ctl.value, "") = "" then missing = missing & vbcrlf & ctl.name end if end if next if missing <> "" then msgbox " : الحقول التالية فارغة" & vbcrlf & missing, vbinformation+ vbmsgboxright, "" exit sub end if docmd.runcommand accmdsaverecord docmd.gotorecord,,acnewrec طبعاً ، إذا كنت من الأشخاص الذين يتركون اسم مربع النص كما هو من مصدره من الجدول ، فقد قمت بإضافة فكرة تحديد اسماء المربعات النصية التي لم يتم ادخال بيانات فيها . بكل الأحوال جرب وأخبرنا بالنتيجة ، عل أحد الأساتذة والأخوة يتابع معك من كمبيوتر 🥴 على كل حال جرب خطر على بالي نقطة أخرى من خلال السطر :- missing = missing & vbcrlf & ctl.name بأن نستبدله بالسطر التالي :- missing = missing & vbcrlf & ctl.controls(0).caption فهنا سيأقرأ التسمية ( label ) المرتبطة بكل مربع نص بدلاً من اسم مربع النص نفسه .

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

تعملها ويطلع منك

تفتكر هيكون آمن إذا استخدم لوحده بدون ( Salt ) ؟؟ وحبة الملح دي هي اللي ممكن تزيد من مستوى الحماية في كلمات المرور ..

ننتظر عودتكم بموضوع منفصل للإفادة 😇 للأسف مع تحفظي ، الكثير من المواضيع يُـمَـرُّ عليها مرور الكرام ... 😅 نعم صحيح ، وانا كنت أحدهم على فكرة هههههه إلا أنني توجهت من فترة الى تطبيق الحماية على البيانات والإهتمام بأمانها بجانب الإهتمام بأمن البرنامج ( مشاريعي الخاصة للأعضاء طبعاً وليس ما أشاركه هنا ) دمتم بخير 😇

اولا ، وعليكم السلام ورحمة الله وبركاته 🤗 اخي الكريم ، اهتمامك بمواضيعك من حيث العنوان الصحيح والمناسب يساعدك لاحقاً على أن تجد المساعدة بشكل أسرع . على العموم ، اذا كان اصدار الويندوز الذي تم تثبيته = ويندوز 10 أو أحدث ، فراجع هذا الرابط من بدايته ..

وعليكم السلام ورحمة الله وبركاته 🤗 أخي الكريم فعلاً الكثير من المواضيع التي تحدثت عن هذه المشكلة ،، حاول رفع ملفك على جوجل درايف أو mediafire ، وارسل الرابط.

ما شاء الله ، مبدع فيما طرحت . أثار الموضوع اهتمامي سابقاً في مناقشة سابقة ومداخلة قوية لك ، مما جعلني أتحرى عن موضوع الحقن بشكل عميق وأحاول تنفيذه في مشاريعي تالياً .. ومن سياق الحديث الذي طرحته ، اعتقد أن استخدام المعلمات بدلاً من سلاسل نصية سيكون من خطوات الأمان التي قد يجب تنفيذها . أيضاً على ما أعتقد استخدامنا لمطهرات النصوص قد يأتي بنتيجة جيدة ومساعدة ,, على سبيل المثال ، هذه فكرة بسيطة أيضاً وقد تكون قابلة للتطوير والتحديث بشمولية ,, If InStr(Me.txtUser, "'") > 0 Or InStr(Me.txtUser, ";") > 0 Then MsgBox "تم استخدام رموز غير مسموح بها في اسم المستخدم", vbExclamation Exit Sub End If ولهذا السبب كنت قد استخدمت محاولة لم أقم بتجربتها بعد ، على أحد المشاريع باستخدام هذه الدالة :- Public Function Sanitizer(ByVal userInput As String, Optional ByVal context As String = "sql") As String Dim sanitized As String sanitized = Trim(userInput) Select Case LCase(context) Case "sql" sanitized = Replace(sanitized, "'", "''") sanitized = Replace(sanitized, ";", "") sanitized = Replace(sanitized, "--", "") Case "name" sanitized = Replace(sanitized, "'", "") sanitized = Replace(sanitized, ";", "") sanitized = Replace(sanitized, "*", "") sanitized = Replace(sanitized, "=", "") Case "pure" Case Else sanitized = Replace(sanitized, "'", "''") End Select Sanitizer = sanitized End Function وعلى سبيل المثال كإستخدام في الاستعلامات :- Dim filter As String filter = "[U_UserName]='" & Sanitizer(Me.txtUser, "sql") & "' AND [U_Password]='" & Sanitizer(Me.txtPass, "sql") & "'" DoCmd.OpenForm "frmDashboard", , , filter وكمثال على ما طرحته سابقاً لفتح نموذج بفلترة .. DoCmd.ApplyFilter , "[U_UserName]='" & Sanitizer(Me.txtSearch, "sql") & "'" أو حتى في نموذج تسجيل الدخول لاسم المستخدم ، كانت المحاولة :- Dim newUser As String newUser = Sanitizer(Me.txtNewUser, "name") هذه كانت الفكرة التي خطرت لي ، ولكن لاحقاً قمت بتحديثها لإظهار رسالة تحذيرية تلقائية إذا تم رصد مدخل خطير أو محاولات حقن نصية 😁

وعليكم السلام ورحمة الله وبركاته .. في مرفقك ، الورقة "MD1 15-2020-16" موجودة في الأساس ، وأنت تريد ترحيل البيانات اليها مسبقاً ، ثم تريد انشاء نسخة من الورقة Main بنفس الاسم الموجود في الخلية B2 في Main صحيح !!!! وضحها اذا سمحت 😅

تفضل أخي الكريم ، محاولتي البسيطة . حيث في الورقة الثانية = موقف الغياب اليومي ، قمت بإضافة زر للتحديث ، وتم استدعاءه للدالة التي تم انشاؤها في مديول عام :- Sub ExtractAbsentEmployees() Dim wsMain As Worksheet Dim wsReport As Worksheet Dim targetDate As Date Dim dayNum As Integer Dim targetCol As Integer Dim lastRow As Long Dim i As Long Dim reportRow As Long Set wsMain = ThisWorkbook.Sheets("MainSheet") Set wsReport = ThisWorkbook.Sheets("موقف الغياب اليومي") wsReport.Range("A5:D" & wsReport.Rows.Count).ClearContents targetDate = wsReport.Range("C2").Value dayNum = Day(targetDate) targetCol = 3 + dayNum If targetCol < 4 Or targetCol > 34 Then MsgBox ".تاريخ غير صالح يجب أن يكون اليوم بين 1 و 31", vbExclamation Exit Sub End If lastRow = wsMain.Cells(wsMain.Rows.Count, "B").End(xlUp).Row reportRow = 5 For i = 4 To lastRow If wsMain.Cells(i, targetCol).Value = "غ" Then wsReport.Cells(reportRow, 1).Value = wsMain.Cells(i, 1).Value wsReport.Cells(reportRow, 2).Value = wsMain.Cells(i, 2).Value wsReport.Cells(reportRow, 3).Value = wsMain.Cells(i, 3).Value wsReport.Cells(reportRow, 4).Value = targetDate reportRow = reportRow + 1 End If Next i If reportRow = 5 Then MsgBox "لا يوجد موظفين متغيبين في هذا التاريخ", vbInformation End If End Sub وفي الورقة الثالثة "موقف الغياب الشهري" ، أيضاً تم انشاء زر لاستدعاءه الدالة التالية من نفس المديول :- Sub GenerateMonthlyAbsenceReport() Dim wsMain As Worksheet Dim wsReport As Worksheet Dim startDate As Date, endDate As Date Dim currentDate As Date Dim dayNum As Integer, targetCol As Integer Dim lastRow As Long, reportRow As Long, i As Long Dim empName As String, empJob As String Dim dateList As String, dayList As String Dim dateCount As Integer Dim dayName As String Set wsMain = ThisWorkbook.Sheets("MainSheet") Set wsReport = ThisWorkbook.Sheets("موقف الغياب الشهري") If Not IsDate(wsReport.Range("C2").Value) Or Not IsDate(wsReport.Range("C3").Value) Then MsgBox "الرجاء إدخال تاريخين صالحين في الخلايا C2 و C3", vbExclamation + vbMsgBoxRight, "" Exit Sub End If startDate = wsReport.Range("C2").Value endDate = wsReport.Range("C3").Value If startDate > endDate Then MsgBox "خطأ: تاريخ البداية يجب أن يكون قبل تاريخ النهاية", vbExclamation + vbMsgBoxRight, "" Exit Sub End If Application.ScreenUpdating = False Application.Calculation = xlCalculationManual With wsReport .Range("A6:F" & .Rows.Count).ClearContents .Range("6:" & .Rows.Count).RowHeight = 15 End With lastRow = wsMain.Cells(wsMain.Rows.Count, "B").End(xlUp).Row reportRow = 6 For i = 4 To lastRow empName = wsMain.Cells(i, 2).Value empJob = wsMain.Cells(i, 3).Value If empName = "" Then GoTo NextEmployee dateList = "" dayList = "" dateCount = 0 currentDate = startDate Do While currentDate <= endDate dayNum = Day(currentDate) targetCol = 3 + dayNum If targetCol >= 4 And targetCol <= 34 Then If wsMain.Cells(i, targetCol).Value = "غ" Then dayName = wsMain.Cells(2, targetCol).Value If dateList <> "" Then dateList = dateList & vbLf & Format(currentDate, "yyyy-mm-dd") dayList = dayList & vbLf & dayName Else dateList = Format(currentDate, "yyyy-mm-dd") dayList = dayName End If dateCount = dateCount + 1 End If End If currentDate = DateAdd("d", 1, currentDate) Loop If dateCount > 0 Then With wsReport .Cells(reportRow, 1).Value = reportRow - 5 .Cells(reportRow, 2).Value = empName .Cells(reportRow, 3).Value = empJob .Cells(reportRow, 4).Value = dateCount .Cells(reportRow, 5).Value = dateList .Cells(reportRow, 6).Value = dayList .Cells(reportRow, 5).WrapText = True .Cells(reportRow, 6).WrapText = True If dateCount > 1 Then .Rows(reportRow).RowHeight = 15 * dateCount End If End With reportRow = reportRow + 1 End If NextEmployee: Next i Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic If reportRow > 6 Then ' MsgBox "تم إنشاء التقرير بنجاح", vbInformation + vbMsgBoxRight, "" Else MsgBox "لا توجد أيام غياب في الفترة المحددة", vbInformation + vbMsgBoxRight, "" End If End Sub وتركت لك التعديل متاحاً من خلال تحديد الصف أو العمود ... إلخ . وهذا ملفك بعد التعديل . راجعه وأخبرنا بالنتيجة .. موقف غياب موظفين.zip

تحويل الدالة الى دالة عامة ، يتم استدعائها في أي نموذج ، توسيع الفكرة اختيار التاريخ لا يعمل بشيت b-c-d.xlsm ملاحظة مهمة ، يجب ان يكون الـ CheckBox بجانب الخلية المستهدف إدرا الوقت والتاريخ فيها . أي على يسار الخلية وإذا كانت الخلية المستهدفة على اليسار ، نقوم باستبدال الجزء +1 الى -1 في الدالة داخل المديول

قد سبقني السباقون الأساتذة .. ما شاء الله عليهم .. عذراً للتأخر في الرد ، ولكن يبدوا أنهم قد أجادوا بما طرحوا ، ويسعدني نقلك للإجابة لأي حل آخر تراه مناسباً لك ( بصدر رحب طبعاً ) .

معلمي الفاضل ، اعتذر عن التأخر بالرد ، ولكن فعلاً تفاجأة بضيوفي من العائلة 😅 ولوقت متأخر لم أتمكن من المتابعة ,, على العموم ، وبما انك رأيت ان فكرة الحقلين هي الأنسب لك والأوفر والأقل جهداً ، قد يكون قرارك صائباً برؤية أبعد .. على العموم بانتظار مرفقك المعدل ، ومتابع معك .

وعليكم السلام ورحمة الله وبركاته ,, حاولت فهم المطلوب بشكل واضح ، وخرجت بهذه الفكرة . حيث انشأت زر للتنفيذ ، يحتوي الكود التالي :- Private Sub Btn_1_Click() Dim wsMain As Worksheet Dim wsTarget As Worksheet Dim lastRow As Long Dim i As Long Dim targetCol1 As String, targetCol2 As String Dim sourceCol1 As String, sourceCol2 As String Set wsMain = ThisWorkbook.Sheets("F") Dim targetSheetName As String targetSheetName = wsMain.Range("F6").Value On Error Resume Next Set wsTarget = ThisWorkbook.Sheets(targetSheetName) On Error GoTo 0 If wsTarget Is Nothing Then MsgBox " : الورقة المحددة غير موجودة" & targetSheetName, vbExclamation + vbMsgBoxRight, "" Exit Sub End If If wsMain.Range("G6").Value = "قوى" Then sourceCol1 = "L" sourceCol2 = "M" targetCol1 = "H" targetCol2 = "I" ElseIf wsMain.Range("G6").Value = "تامين" Then sourceCol1 = "O" sourceCol2 = "P" targetCol1 = "H" targetCol2 = "I" Else MsgBox "يجب اختيار 'قوى' أو 'تامين' في الخلية G6", vbExclamation + vbMsgBoxRight, "" Exit Sub End If wsMain.Range("H6:I" & wsMain.Rows.Count).ClearContents lastRow = wsTarget.Cells(wsTarget.Rows.Count, sourceCol1).End(xlUp).Row lastRow = Application.WorksheetFunction.Max(lastRow, wsTarget.Cells(wsTarget.Rows.Count, sourceCol2).End(xlUp).Row) For i = 6 To lastRow If wsTarget.Range(sourceCol1 & i).Value <> "" Then wsMain.Range(targetCol1 & (i - 0)).Value = wsTarget.Range(sourceCol1 & i).Value End If If wsTarget.Range(sourceCol2 & i).Value <> "" Then wsMain.Range(targetCol2 & (i - 0)).Value = wsTarget.Range(sourceCol2 & i).Value End If Next i MsgBox "تم نقل البيانات بنجاح", vbInformation + vbMsgBoxRight, "" End Sub جرب المرفق وأخبرنا بالنتيجة .. BB.zip

لهذا السؤال :- هذا سيعتمد على ما إذا كان لكل موظف فترة واحدة فقط يومياً ( ومن سياق الحديث السابق لا اعتقد ذلك !! ) ، فيكفي ربط الدالة بمعرف الموظف فقط . أما إذا كان يمكن أن يسجل الموظف توقيعاً في أكثر من فترة (صباحي + مسائي) ، فهنا من الأفضل أن تأخذ الدالة أيضاً FtraID ( رقم الفترة ) لضمان دقة التحليل . والدالة الجميلة ، لي تعقيب واحد عليها . في السطر :- If minutes > 59 Then hours = hours + 1: minutes = 0 أرى أنه غير ضروري !! لأنه من المستحيل أن تكون minutes أكبر من 59 بسبب عملية Mod 60 السابقة !!!! أما فيما يخص الدالة ، فقط لأني سأخرج من العمل بعد قليل ، وسأحاول البدء بمشاركة بسيطة بأقرب فرصة .

قد يكون تنسيق الوقت !!! لكن انظر الوقت والتنفيذ الآن .. دعنا منها الآن .👍. طبعاً إذا كان لكل فترة وقت إتاحة مخصص ومختلف عن الفترة السابقة . أي لا نريد شمول الفترات جميعها بوقت إتاحة ثابت !! ومن هنا كل شيء سيكون عبارة عن بيانات وليس برمجة .. وهذه خطوة ذكية جداً أنك ستعتمد على حقول محسوبة .. وعلى سبيل المثال بهذا الشكل رح نعتمد على start_signin و end_signout بدل ما نعتمد على VBA ( start_signin و end_signout = حقلين افتراضيات يعبران عن بداية ونهاية التوقيع )

معلمي الفاضل .. بناءً على ما أسلفتم ، ومن خلال الجدول الجديد الخاص بالتحكم :- تم تعديل اسلوب مطابقة الفترة لتراعي السماح قبل و بعد . التحقق من آخر توقيع للموظف بحيث إذا مضى عليه أقل من waitBtween دقيقة ، فيتم رفض التوقيع الجديد . وبناءً عليه ، يكون تعديلي بهذا الشكل :- Private Sub ID_AfterUpdate() On Error GoTo Err_Handler Dim db As DAO.Database Dim rsEmp As DAO.Recordset Dim rsShift As DAO.Recordset Dim rsCtrl As DAO.Recordset Dim rsLastMove As DAO.Recordset Dim UserId As String Dim empName As String Dim currentTime As Date Dim shiftId As Variant Dim checkType As String Dim sql As String Dim periodName As String Dim startWork As Date, endWork As Date Dim allowedBefore As Long, allowedAfter As Long, waitBetween As Long Dim lastTime As Date UserId = Trim(Me.id) If UserId = "" Then MsgBox "يرجى إدخال رقم الموظف", vbExclamation + vbMsgBoxRight, "" Exit Sub End If currentTime = Time() Set db = CurrentDb sql = "SELECT * FROM tblNames WHERE UserId = '" & UserId & "'" Set rsEmp = db.OpenRecordset(sql) If rsEmp.EOF Then MsgBox "رقم الموظف غير موجود في جدول الموظفين", vbExclamation + vbMsgBoxRight, "" rsEmp.Close Exit Sub End If empName = Nz(rsEmp!s_name, "الموظف") rsEmp.Close Set rsCtrl = db.OpenRecordset("SELECT TOP 1 * FROM tbl_Ctrl") If rsCtrl.EOF Then MsgBox "يرجى التحقق وضبط اعدادات التحكم", vbCritical + vbMsgBoxRight, "" Exit Sub End If waitBetween = Nz(rsCtrl!waitBtween, 1) allowedBefore = Nz(rsCtrl!timeBefore, 0) allowedAfter = Nz(rsCtrl!timeAfter, 0) rsCtrl.Close shiftId = "0" periodName = "غير محددة" Set rsShift = db.OpenRecordset("SELECT * FROM tbl_Ftrat") Do While Not rsShift.EOF startWork = DateAdd("n", -allowedBefore, rsShift!start_work) endWork = DateAdd("n", allowedAfter, rsShift!end_work) If currentTime >= TimeValue(startWork) And currentTime <= TimeValue(endWork) Then shiftId = CStr(rsShift!id) periodName = rsShift!ftraName Exit Do End If rsShift.MoveNext Loop rsShift.Close '------------------------- ( في حال أردنا التخصيص ) '' If shiftId = "0" Then '' MsgBox "لا توجد فترة مناسبة للوقت الحالي ، لا يمكن تسجيل التوقيع", vbExclamation + vbMsgBoxRight, "" '' Exit Sub '' End If '------------------------- sql = "SELECT TOP 1 chekInOut FROM tblcomIn WHERE UserId = '" & UserId & "' ORDER BY chekInOut DESC" Set rsLastMove = db.OpenRecordset(sql) If Not rsLastMove.EOF Then lastTime = rsLastMove!chekInOut If DateDiff("s", lastTime, Now) < (waitBetween * 60) Then MsgBox "لا يمكنك التوقيع مرتين خلال أقل من " & waitBetween & " دقيقة", vbExclamation + vbMsgBoxRight, "" rsLastMove.Close Exit Sub End If End If rsLastMove.Close sql = "SELECT TOP 1 chekType FROM tblcomIn WHERE UserId = '" & UserId & "' AND DateValue(chekInOut) = Date() AND FtraID = '" & shiftId & "' ORDER BY chekInOut DESC" Set rsLastMove = db.OpenRecordset(sql) If Not rsLastMove.EOF Then If rsLastMove!chekType = "1" Then checkType = "2" Else checkType = "1" End If Else checkType = "1" End If rsLastMove.Close sql = "INSERT INTO tblcomIn (UserId, chekInOut, chekType, FtraID) VALUES " & _ "('" & UserId & "', #" & Format(Now, "yyyy-mm-dd hh:nn:ss") & "#, '" & checkType & "', '" & shiftId & "')" db.Execute sql, dbFailOnError MsgBox "تم تسجيل " & IIf(checkType = "1", "الدخول", "الخروج") & vbCrLf & _ "الموظف: " & empName & vbCrLf & "الفترة: " & periodName, vbInformation + vbMsgBoxRight, "" Me.id = "" Me.id.SetFocus Exit Sub Err_Handler: MsgBox " : خطأ أثناء تنفيذ العملية" & vbCrLf & Err.Description, vbCritical + vbMsgBoxRight, "" End Sub ملاحظة .. في الجزء :- shiftId = "0" periodName = "غير محددة" استخدمته لتهيئة متغيرين رئيسيين قبل الدخول في حلقة البحث عن الفترة الحالية المناسبة ( tbl_Ftrat ) . حيث أن القيمة ( 0 ) هنا تعني مبدئياً : ( لا توجد فترة مناسبة تم تحديدها بعد ) . وطبعاً سيتم تعيين قيمة فعلية له لاحقاً من الجدول tbl_Ftrat عندما يطابق الوقت الحالي فترة ما داخل الجدول . من خلال الجملة :- If currentTime >= TimeValue(startWork) And currentTime <= TimeValue(endWork) Then shiftId = CStr(rsShift!id) بحيث إذا وجد وقت يطابق الفترة ، يتم تعيين رقم الفترة الحقيقي . وكذلك الأمر فيما يتعلق بـ "غير محددة" .... والهدف كان في فكري ، للتحكم في الحالات غير المتوقعة :- فإذا لم يعثر على فترة مناسبة ضمن الوقت والسماح ، تبقى القيم الافتراضية ( 0 و غير محددة ) . ولتسجيل التوقيع حتى في حال عدم المطابقة . في بعض الحالات ، قد ترغب بتسجيل التوقيع رغم عدم انطباقه على أي فترة . ( من باب الإحتياط ) وطبعاً قابل لتخصيصه كجزء شرطي . فمثلاً إذا أردت منع التوقيع تماماً في حالة عدم مطابقة أي فترة ، يمكن وضع شرط كالآتي في نهاية حلقة البحث :- Loop rsShift.Close If shiftId = "0" Then MsgBox "لا توجد فترة مناسبة للوقت الحالي ، لا يمكن تسجيل التوقيع", vbExclamation + vbMsgBoxRight, "" Exit Sub End If وطبعاً سيتم إلغاء التسجيل وعدم تنفيذ باقي الكود !!! وطبعاً وجب التذكير بأنني أخذت على عاتقي تعديل منطق احتساب وقت الانتظار بين التوقيعين ليكون مقروناً ومشروطاً بالموظف الحالي فقط . يعني لو أردنا الانتظار دقيقة لتسجيل الحضور لـ 20 موظف على سبيل المثال !! فهذا يعني أن آخر موظف سيكون متأخراً 20 دقيقة هههههههه حسب الوقت الذي سيتم تسجيله له ( صحيح ) ، ولذا ألزمت التحقق من فترة الانتظار برقم الموظف . فكرتي المتواضعة .. comOutDb2.zip