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

كل الانشطه

هذه الصفحة تحدث تلقائياً

  1. الساعة الأخيرة
  2. السلام عليكم عندي كود اريد التعديل عليه - التعديل المطلوب هو هناك في الملف الاصلي لقسم أو شعبة اكثر من تاريخ أي ان التقرير للفترة يوم أو يومين او ثلاث او شهر او سنة فيكون من ففترة الى فترة حاليا الكود يقوم بوضع تاريخ واحد كما تظهر بالنتيجة كما في الملف المرسل (مثال لشعبة الرمادي والفلوجة ) والصحيح ان الملف(الكل) يحتوي على أكثر من تاريخ ولكن بالنتائج ياخذ فقط تاريخ واحد وهو أول تاريخ أما الملف الاصلي الذي يحتوي على البيانات هو كما في الملف الكل الموجود في مجلد التقارير الذي يحتوي لبعض الاقسام أكثر من تاريخ - واليك البرنامج الذي يحتوي على الكود في البرنامج هناك مفتاح اسمه ملف انشاء ملفات الاقسام الذي يحتوي على الكود والمطلوب التعديل عليه والرقم السري للدخول للمحرر الاكواد 1967=1967 الرمادي_25-03-2026.xlsx الفلوجة_25-03-2026.xlsx الكل.xlsx البرنامج.xlsm
  3. وعليكم السلام ورحمة الله وبركاته خلينا نتكلم بصراحة ومن غير أي تجميل اللي بيحصل دلوقتي مش تراجع منتدى اللي بيحصل إن طريقة التعلم نفسها اتغيرت وفي ناس لسه مصممة تتعامل بعقلية زمن فات زمان… اللي عنده معلومة كان مصدر قوة دلوقتي… نفس المعلومة بقت متاحة لأي حد في ثواني فالسؤال الحقيقي بقى: إيه القيمة الفعلية للخبير انهارده؟ هل:يكتب الكود من الصفر؟ واللا: يفهم، يراجع، ويصحح اللي بيتولد قدامه؟ خلينا نبقى أوضح دلوقتي فيه نوعين: مستخدم أدوات: ينسخ من AI يجرب لو اشتغل خلاص مطور فاهم يبص على نفس الكود ويقول: ده غلط ليه و ده خطر فين وامتى ينهار الحقيقة اللي ممكن تضايق البعض: فيه ناس كانت قيمتها إنها "تعرف الحل" النهارده الحل بقى متاح للجميع فلو القيمة ما اتطورتش طبيعي إنها تقل طيب هل AI بديل للخبراء؟ الإجابة قطعا و ببساطة: لا AI لا يفهم النظام بل هو فقط يتوقع و لكن لا يشغل الكود و لا يرى النتائج و لا يختبر الحالات الشاذة و لا يعيش بيئة أكسس بكل مشاكلها هو فقط يقول: ده شكل كود غالبا بيشتغل وهنا الخدعة الخطيرة الكلام الناتج منه ظاهريا تجده : منظم واثق و مقنع فيتكون انطباع عند البعض إنه "فاهم" لكن الحقيقة: دي بلاغة لغوية مش خبرة تنفيذية: لانه مجرد وفقط الة تقليد لغوي ليست مفسركود بل مولد نصوص احتمالي متى يضللك فعلا؟ لما تديله Bug خفي Edge Case أو سلوك غير موثق في أكسس ساعتها: يخترع تفسير منطقي شكله صح ظاهريا لكنه فعليا غلط فتدخل في دايرة: تجرب → تكتشف خطأ → تصلح → يبوظ تاني وهنا المفارقة أحيانا AI: لا يوفر وقت بل يضاعف وقت التصحيح بينما لما تكتب بإيدك: ممكن تغلط لكنك تفهم لماذا في أكسس تحديدا… المشكلة أكبر لأنه مليان سلوكيات غير موثقة فيه تفاعلات غريبة مع API فيه Edge Cases غير متوقعة وأدوات AI: لا تعيش هذه البيئة و لا تختبرها و لا تعرف حدودها لكنها تتكلم بثقة بلاغية فقط الخلاصة بدون مجاملة اللي فاهم → AI هيقويه اللي مش فاهم → AI هيغرقه تعامل مع AI كـ: مرجع سريع و مساعد مش: مصدر نهائي ولا عقل بديل الاعتماد الأعمى → كارثة الاستخدام الواعي → قوة
  4. Today
  5. تسلم استاذي عالمشاركه حقيقه اول مره اتطرق لطريقه زي دي وعن قريب ممكن اجرب الموضوع ان شاء الله تسلم يا استاذنا عالمشاركه فالحقيقه انا لم اجرب غير الاكسس الا البايثون وبعض اجزاء من ال c# ولكني انشأت اكتر من مشروع لقواعد بيانات فعلا كامل متكامل بالذكاء الاصطناعي استاذنا الكببر تسلم لمشاركتك وقد اتطلعت علي المشاركه من قبل سواء كانت مؤيده او معارضه ولازلت مقتنع بقدره الانسان علي استغلاله صح اذا احسن في اختيار معطياته بدقه حتي يحصل علي مخرجات مبهره
  6. بارك الله فيك اخي والحقيقة كان كلامك في البداية في محله ونسأل الله الهداية اما عن سؤالك سأقوم بتجزئته إلى جزئين (التوقعات بشأن قواعد بيانات أكسس كإطار عمل) و (التوقعات بشأنه مع تطور الذكاء الصناعي) فيما يخص الجزء الأول من السؤال فبالمناسبة دائما ما يُسأل لي وتكون إجابتي غلى شكل مثال كالتالي تخيل أن لدينا سيارة نقل صغيرة ذات 4 عجلات وشاحنة نقل كبيرة ذات إثنا عشرة عجلة وانت صاحب بقالة صغيرة وأغلب عملك اليومي يقتصر على توريد بضاعة صغيرة (كرتون واحد من كذا صنف مثلاً) فهل سيكون من الأجدى لك إستئجار السيارة الصغيرة أم الشاحنة الكبيرة؟ وهذا هو الحال مع قواعد البيانات (أو بالأصح مع البرامج والتطبيقات الخاصة بقواعد البيانات) حيث سيكون من الأجدى لأصحاب المشاريع الصغيرة إستخدام تطبيق تم تطويره بإستخدام أكسس لأكثر من سبب منها على سبيل المثال لا الحصر: - غالبا من يبدأ بتأسيس المشاريع الصغيرة يكونون من الشباب رواد الاعمال وهذا يعني أنه من الوارد أن يتم تعديل آليات العمل أكثر من مرة حتى يتم التوصل إلى آلية عمل شبه ثابتة ومن هذا المنطلق فأيهما سيكون الأرخص والأكثر مرونة أن يتم تنفيذ التعديل بإستخدام أكسس أم بإستخدام أحد البرامج الكبيرة الأخرى؟ - وحتى لو قلنا أن هذا المشروع قد أنشئ بعد دراسة كافية ووافية ولن يتطلب أي تعديلات (والذي من واقع خبرتي أراه شبه مستحيل) فهل سيتطلب حجم البيانات لمشروع صغير يعمل فيه عشرة موظفين وحجم تعاملاته لاتتجاوز مائة أو مائتين الف دولار شهريا لبرنامج وقاعدة بيانات سيكلف المشروع الاف الدولارات للدعم الفني فقط؟ - أهم مايميز اكسس هو أنها بيئة قواعد بيانات علائقية وهذا يعني أن أسلوب تصميم وبناء قاعدة البيانات فيه هو نفس الأسلوب لتصميم وبناء قواعد البيانات في أي بيئة أخرى وهكذا فعندما يكبر حجم المشروع سيكون من السهل نقل (هجرة) البيانات إلى أي قاعدة بيانات أخرى - في الاونة الاخيرة بدأت مايكروسوفت ببعض الاضافات والتحسينات كما رأينا في إضافة كائن عنصر تحكم متصفح Edge او تحديث عنصر تحكم الرسوم البيانية وكذا محرر الاستعلامات موناكو وغيرها من الاضافات والتحسينات التي سيتم اضافتها في المستقبل وأعتقد أن مايكروسوفت لم تقم بهذه التحديثات إلا على ضوء نتائج دراسة للسوق قامت بها وجعلها تستشعر أهمية هذا التطبيق من أوفيس (المظلوم من حيث التحديثات مقارنة ببقية تطبيقات أوفيس الأخرى) وهذا إن دل على شيئ فإنما يدل على أن هناك توجه كبير نحو العمل بإستخدام أكسس في المستقبل. وفيما يخص الجزء الثاني من السؤال (التوقعات بشأنه مع تطور الذكاء الصناعي) فوجهة نظري أن المبالغة في إستخدامه لن يفيد أحد - الغير فاهم سيخاطر بإستخدام برنامج لايعلم إن كان صحيحاً أم مليئا بالأخطاء والأخطار التي قد يتسبب بها على المدى القريب او البعيد - المبتدئ الذي يريد التعلم لن يتعلم شيئاً فمن خلال رحلة تعلمي لم أجد أفضل طرق للتعلم إلا شيئ واحد هو التجربة والخطأ فإذا لم يمارس المبتدئ العمل بنفسه ويظل يجرب ويخطئ فلن يتعلم أي شيئ - المحترف لابأس في أن يستخدم الذكاء الصناعي للمساعدة في حل جزئية معينة (جزئية وليس الكل) كذلك يمكن إستخدامه للمساعدة في تصور شكل النماذج والتقارير أو إقتراح الخطوط العريضة للبرنامج لإستخدامها للعصف الذهني لإستنباط الأفكار فقط أما أن يستخدمه في إنشاء برنامج من الألف إلى الياء فهذا أنا ضده تماماً. فكما يعلم الجميع فأن كتابة البرنامج من الصفر أسهل من مراجعة برنامج قام به شخص آخر والشيئ الثاني أن قيام المطور بكتابة الكود بنفسه يجعله ملماً بأدق تفاصيله وعند حدوث أي خطأ يكون من السهل معرفة موقعه ومعرفة تأثير التعديل الذي سيتم على الكود لإصلاح الخطأ على بقية الأكواد وحتى ولو إفترضنا جدلاً أن الذكاء الصناعي قام بإنشاء تطبيق صحيح 100% (سواء كان أكسس أو غيره) فهل سيتمكن المطور من حل أي مشكلة قد تظهر في المستقبل؟ وإذا كان يعمل ولم تظهر أخطاء فهل سيكون لدى المطور الذي سيدّعي القيام بالعمل الثقة الكافية فيه أم سيظل حاطط يده على قلبه في إنتظار المكالمة التي تخبره بظهور خطأ ... والا أنتو إيه رأيكو 😅؟
  7. السلام عليكم ورحمه الله اتفضل لعله المطلوب بسم الله.xlsm
  8. ليس لدي نسخة 2003 حتى أقوم بالتجربة ، ولكن الأمر مرهون بتجربتك على أكثر من إصدار أخي الكريم .. جرب كلا الحلين وأعتقد أنك سترسو على بر الإجابة بأمان .
  9. في الحقيقة هذا الكلام كبيراً على عقلي الصغير فعلياً ، وليس لي تجربة حقيقية بهذا المجال ( الـ MCP ) .. ولكن من خلال فيديوهاتك التي ارفقتها في أحد المواضيع ، توضحت جزئياً الفكرة والهدف المرجو من الـ MCP .. من تجارب صديق لي في استخدام الذكاء الصناعي بإنشاء مشاريع بايثون ، فأكد لي فعلياً انه مجرد جعل الذكاء يفهم المطلوب حتى يقوم بإنشاء مشروع جاهز بصيغته Py على ما اذكر .. لكن لم تمر علي تجربة لإنشاء Accdb جاهز وكامل متكامل من خلال الذكاء الصناعي .. هذا والله أعلم ..
  10. مشكله الاكسس يختلف عن البقية حيث في البايثون تستطيع ان تنشئ برنامج من الصفر الى قاعده البيانات وبواجهه اماميه وخلفيه بكل سهوله اما في الاكسس وهو برنامج مغلق لابد من استخدام الام سي بي سيرفر حتى تستطيع ان تتحكم داخل الاكسيس طبعا هناك الكثير من مشاريع الام سي بي سيرفر كمثلا كهذا المشروع https://github.com/tyler-73/MS-Access-mcp يدعي صاحبها ان هناك تحكم كامل بكل الاكسس عن طريق الذكاء الاصطناعي طبعا انا لم اجرب هذا المشروع انا انشئت ما ام سي بي سيرفر فب الجيت هب واحاول الان ان اجد حل للهلوسة التي تحدث للذكاء الاصطناعي عن طريق الام سي بي سيرفر طبعا الان انا استخدم skill.me طبعا لم تقضي على الهلوسه بشكل كامل كان الحل النهائي استخدام الام سي بي سيرفر للاتصال بقاعده البيانات واضافه وحذف ....... اما التنفيذ الحرفي للاضافة والحذف.....عن طريق سكربت البايثون والتعليمات العامه عن طريق ملف skill.md طبعا لماذا ملف الام سي بي سيرفر لا يحتوي على التعليمات بشكل حرفي لانه الام سي بي سيرفر يجب ان يتعامل مع كل قواعد البيانات اما ملف البايثون فهو يستخدم وينشأ لكل قاعده بيانات على حدا اما ملف الاسكيل الام الدي خوفا من الهلوسه
  11. شكراً للسادة الأعزاء Foksh ، ابو جودي مبدئياً .. التطبيقان كل منهما يلبى المطلوب فى بيئة تشغيله عند التشغيل على أكسس 2003 يقوم باللازم نحو اللاحقة mdb وعند التشغيل على أكسس 2007 يتعامل مع الملفات دات اللاحقة accdb أحتاج لمزيد من التجارب لاحقاً !!
  12. اسف للمرة المليون يوجد خطأ بالمعادلات خطأ بالمعادلات من M10 : M14 توزيع عدد الحصص.xlsm
  13. السلام عليكم ورحمه الله وبركاته عباقرة واساتذه وعمالقة اكسس اتمني من الله ان يوفقكم جميعا لما فيه الخير والصلاح بالمناسبه انا عارف ان الموضوع ليس بجديد علي الكثير منكم وبالفعل يستخدمه الكثير والكثير منا في عمله علي بعض الاكواد او التصاميم واصلا الهدف من فتحي موضوع جديد هو توصيل رساله للجميع وانا اولكم دون تقليل لاحد الهدف من اي مجموعه او منتدي او مشاركه دائما ما تكون استفاده وليس استعراض قوى او عضلات او مبارزه او مشاحنه فالذكاء الاصطناعي الان اصبح يدخل فكافه الجوانب ( انا شخصيا استخدمته كثيرا في تصميم قواعد بيانات كامله من الالف للياء - واستخدمته علي نطاق واسع بدايه من تصميم الجداول والاستعلامات حتي إني خليته يصمملي تصاميم النماذج والتقارير ويعطيني اكواد ودوال كامله تصمم عني ) كنتم دائما حريصين علي افاده الكثير مننا بالافكار والطرق وكان المنتدي ملئ بالكثير من الاستشارات والمواضيع حتي ان كل ساعه كان بينزل منشور او اتنين سواء من سائل او من احد الخبراء لو كان احد حتي غاب عن الموقع كان بيبقي فيه بوست للاطمئنان عليه ( هو غاب ليه يا جماعه لعل المانع خير وهكذا ) دلوقتي كما اري ولعلكم ترون جميعا المشاركات قليله وحتي الظاهر منها استعراضات ( وياريتها منافسات سويه انت كويس وانا كويس وده كويس بس ناقصنا كذا او ممكن نعمل كذا احسن وانت تضيف كذا وانا اضيف كذا ) وهكذا راجعو أنفسكم وحاولو ترجعوا الي ما كنتم عليه يرحمنا ويرحمكم الله وعشان كده انا فتحت الموضوع الجديد ( وده حق ليا كعضو فالمنتدي ) واعتقد اني حطيته في مكانه الصحيح عشان لو اتحذف الموضوع او اتنقل الي مكان اخر انا عايز اعرف ايه توقعاتكم لقواعد بيانات اكسس بالمرحله القادمه بناء علي الذكاء الاصطناعي والتطور التكنولوجي القائم واسف علي الاطاله
  14. هذه الثمرة التي تحصل عليها عندما يكون المطلوب واضحاً من بدايته .. جزاكم الله خيراً جميعاً أساتذتنا اللذين ساهموا في حل المشكلة لأخونا @بلانك ...
  15. فعلاً ده كان رد الذكاء الصناعي لما سألته عن الكود خلاف ذلك ، ليس محل نقاش . فيما رأيته :- شكراً لتفاعلك 😎
  16. ما هو فى المرفق القديم بتاعى كنت عامل كده بس يبدو لان حضرتك مأخدتش بالك انا عملتها كده فى المرفق الجديد بس علشان اوضح لحضرتك واثبت لك انها تعمل مع كل الاصدارات فياريت تتأكد من المرفق باسم : تفعيل وإلغاء الشفت2.mdb اللى حضرتك ارفقته وحتجد اساسا انه مافيهوش اى مشاكل اسف انا كتبت الكود وجربته وكان شغال على كل الامتدادت لكل الاصدارات ولكن عند المراجعة استوقفنى استخدام : Workspaces واعتقد ان استخدام :DBEngine.Workspaces(0) يرث إعدادات محرك المشغل الحالي لذلك يبدو ان حضرتك تستخدم اصدار اقل من 2007 لذلك حدثت هذه المشكلة على ما يبدو ودى المرفق الجديد تفعيل وإلغاء الشفت-V2.mdb
  17. بناءً على طلبك أخي @أحمد العيسى ، هذه مشاركة بسيطة ، جربها رجاءً على أوفيس 2003 وأخبرني بالنتيجة .. حيث الأكواد في مديول واحد :- Option Compare Database Option Explicit Private mDbPass As String Public Sub SelectExternalDB(frm As Object) Dim fd As Object Set fd = Application.FileDialog(3) fd.Title = "Select Database" fd.Filters.Clear fd.Filters.Add "Access Files", "*.accdb;*.mdb" If fd.Show = -1 Then frm.Controls("Txt_PathDB").Value = fd.SelectedItems(1) mDbPass = "" CheckShift frm, fd.SelectedItems(1) End If End Sub Public Sub CheckShift(frm As Object, dbPath As String) Dim db As Object, wrk As Object, prp As Object Dim isEnabled As Boolean Set wrk = DBEngine.Workspaces(0) On Error Resume Next Set db = wrk.OpenDatabase(dbPath, False, False, "") If Err.Number = 3031 Then Err.Clear mDbPass = InputBox("قاعدة البيانات محمية، يرجى إدخال كلمة المرور:", "كلمة المرور") If mDbPass = "" Then Exit Sub Set db = wrk.OpenDatabase(dbPath, False, False, ";PWD=" & mDbPass) End If If db Is Nothing Then Exit Sub isEnabled = True For Each prp In db.Properties If prp.Name = "AllowBypassKey" Then isEnabled = prp.Value Exit For End If Next prp If isEnabled Then frm.Controls("OptMain").Value = 2 frm.Controls("Btn_Doit").Caption = "إلغاء تفعيل مفتاح الشيفت" frm.Controls("Lbl_Info").Caption = "الحالة: مفتاح الشيفت مفعل" & vbCrLf & dbPath Else frm.Controls("OptMain").Value = 1 frm.Controls("Btn_Doit").Caption = "تفعيل مفتاح الشيفت" frm.Controls("Lbl_Info").Caption = "الحالة: مفتاح الشيفت غير مفعل" & vbCrLf & dbPath End If db.Close Set db = Nothing End Sub Public Sub ExecuteToggle(frm As Object) Dim dbPath As String dbPath = frm.Controls("Txt_PathDB").Value If Len(dbPath) = 0 Then Exit Sub Dim db As Object, wrk As Object, prp As Object Set wrk = DBEngine.Workspaces(0) On Error Resume Next If Len(mDbPass) > 0 Then Set db = wrk.OpenDatabase(dbPath, False, False, ";PWD=" & mDbPass) Else Set db = wrk.OpenDatabase(dbPath, False, False, "") End If If db Is Nothing Then Exit Sub Dim newState As Boolean If frm.Controls("OptMain").Value = 1 Then newState = True Else newState = False End If db.Properties("AllowBypassKey") = newState If Err.Number = 3270 Then Err.Clear Set prp = db.CreateProperty("AllowBypassKey", 1, newState) db.Properties.Append prp End If db.Close Set db = Nothing CheckShift frm, dbPath End Sub والإستدعاء في زر اختيار الملف :- Private Sub Btn_Select_Click() SelectExternalDB Me End Sub وزر التنفيذ :- Private Sub Btn_Doit_Click() ExecuteToggle Me End Sub وصورة من الأداة :- حيث عند اختيارك لأي قاعدة بيانات ، سيتم الكشف عن حالتها ، إن كان مفتاح الشيفت مفعلاً مسبقاً فسيتم تطبيق الإختيار تلقائياً على Disabled - غير مفعلة . وإذا كان مفتاح الشيفت غير مفعل مسبقاً ، فسيتم تطبيق الإختيار على Enabled - مفعلة . وسيكون التفعيل من خلال زر واحد فقط تتغير تسميته حسب الحالة .. وإذا كانت قاعدة البيانات محمية بكلمة مرور فسيظهر لك رسالة لإدخال كلمة مرور قاعدة البيانات فور اختيارها ، وعند تنفيذ الإجراء الذي تريده للتأكيد .. ShiftEnabled.mdb
  18. فكرة إن الساعة تشتغل حتى في وضع التصميم : مش ميزة بحد ذاتها بالعكس دي إشارة إن الكود شغال خارج دورة حياة أكسس الطبيعية النقطة هنا مش إن "الكود يشتغل وخلاص" لكن يشتغل بشكل قابل للتوسعة ويكون مستقر ومتوافق مع بيئة أكسس الحل المعتمد على SetTimer بسيط في الظاهر لكنه : يعمل خارج دورة عمل النماذج الطبيعية ويمر على جميع النماذج مع كل تحديث زمني ولا يملك إدارة حالة مستقلة لكل نموذج فوق ده كله الاعتماد على On Error Resume Next معناه تجاهل الأخطاء بدل حلها وكأن المشكلة ستختفي بمجرد إخفائها وهذا ليس حلا بل تأجيل للأزمة فقط ومع نمو التطبيق، النتيجة المتوقعة واضحة: تراجع في الاستقرار و انخفاض في الأداء وزيادة في صعوبة الصيانة في المقابل الاعتماد على و استخدام TimerInterval داخل النماذج يعمل داخل دورة الحياة الطبيعية للنماذج ويعتمد على الأحداث بدل المتابعة المستمرة ويتيح تحكما مستقلا لكل نموذج أما نقطة "ما تحللش كتير في الكود ، هو بسيط و واضح ومقروء" : دي مش حجة على قوة و لا على كفائة الكود فهي لا تعكس بساطته بل تتجاهل تقييم تصميمه وتأثيره على المدى الطويل الخلاصة: من يريد كودا قابلا للتوسع والاستقرار يختار TimerInterval أما من يريد حلا سريعا يبدو ذكيا في اللحظة الأولى فليستمر مع SetTimer فالفرق هنا مش تعقيد مقابل بساطة بل: تصميم موجه للتوسع والاستقرار مقابل حل عام سريع التنفيذ البساطة مطلوبة لكن البساطة الحقيقية هي اختيار بنية صحيحة تفضل ثابتة مع نمو التطبيق مش مجرد تقليل عدد الأسطر
  19. تمام بارك الله فيك استاذنا / عبدالله بشير
  20. تم فصل موضوع @Foksh الى
  21. استبدل المعادلة الاولى بالثانية في M10 واسحب لاسفل =IF(COUNTIF(C10:J10;"*")>0;1;0) =IF(SUMPRODUCT(--(C10:J10<>""))>0;1;0)
  22. ملفي انا المخصص للأداة ، لو قدرت على اداتي يبقى انت عملت معجزة وخدمت الشعب العربي كاملاً .. لأنه مستثنى من الكسر الكامل ، لكن تقدر تستخدم التصميم بالنسخة الحالية الخالية من الأكواد 😉 . لا تستغرب ، قد يكون هذا أحد السيناروهات اللي ممكن أسلكها في طريقة عملي .. وقت الجد سأجعلك تجرب بنفسك على أي نسخة من أي مشروع تريده ( لأني لم أستثني أي بصمة وأي مشروع لغاية الآن ) .. لذلك لا تضيع فرصتك الثمينة على ملفي .. ودائماً وأبداً ، يسعدني مروركم العطر هذا
  23. [تعليق جعفر] بالاشارة الى الموضوع التالي بعد فصل الموضوع عن رده في موضوعه المشار إليه أعلاه .. بصوا على الخفة في الأداء😎 :- Option Compare Database Option Explicit Const TargetControlName As String = "CyberClock" '' ' اسم عنصر عرض الوقت النصي ليبل/مربع نص/زر #If VBA7 Then Public Declare PtrSafe Function SetTimer Lib "user32" (ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr Public Declare PtrSafe Function KillTimer Lib "user32" (ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr) As Long Private Declare PtrSafe Function SetWinEventHook Lib "user32" (ByVal eventMin As Long, ByVal eventMax As Long, ByVal hmodWinEventProc As LongPtr, ByVal pfnWinEventProc As LongPtr, ByVal idProcess As Long, ByVal idThread As Long, ByVal dwFlags As Long) As LongPtr Private Declare PtrSafe Function UnhookWinEvent Lib "user32" (ByVal hWinEventHook As LongPtr) As Long Private Declare PtrSafe Function GetAncestor Lib "user32" (ByVal hWnd As LongPtr, ByVal gaFlags As Long) As LongPtr Public NativeTimerID As LongPtr Private WinEventHookID As LongPtr Private AccessHwnd As LongPtr #Else Public Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long Public Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long Private Declare Function SetWinEventHook Lib "user32" (ByVal eventMin As Long, ByVal eventMax As Long, ByVal hmodWinEventProc As Long, ByVal pfnWinEventProc As Long, ByVal idProcess As Long, ByVal idThread As Long, ByVal dwFlags As Long) As Long Private Declare Function UnhookWinEvent Lib "user32" (ByVal hWinEventHook As Long) As Long Private Declare Function GetAncestor Lib "user32" (ByVal hWnd As Long, ByVal gaFlags As Long) As Long Public NativeTimerID As Long Private WinEventHookID As Long Private AccessHwnd As Long #End If Private Const EVENT_SYSTEM_FOREGROUND As Long = &H3 Private Const WINEVENT_OUTOFCONTEXT As Long = &H0 Private Const GA_ROOT As Long = 2 Private gWasStoppedByVBE As Boolean Private gTimerInterval As Long #If VBA7 Then Public Sub NativeTimerCallback(ByVal hWnd As LongPtr, ByVal uMsg As Long, ByVal idEvent As LongPtr, ByVal dwTime As Long) #Else Public Sub NativeTimerCallback(ByVal hWnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long) #End If On Error Resume Next Dim currentTime As Variant Dim timeText As String currentTime = Now() timeText = Format$(currentTime, "hh:nn:ss AM/PM") & vbCrLf & Format$(currentTime, "dddd, dd/mm/yyyy") '' ' 1. الوقت فقط (سطر واحد) '' timeText = Format$(currentTime, "hh:nn:ss AM/PM") ' '' ' 2. التاريخ فقط (سطر واحد) '' timeText = Format$(currentTime, "dd/mm/yyyy") ' '' ' 3. الوقت والتاريخ في سطر واحد '' timeText = Format$(currentTime, "hh:nn:ss AM/PM") & " - " & Format$(currentTime, "dd/mm/yyyy") ' '' ' 4. الوقت فوق التاريخ (سطرين) '' timeText = Format$(currentTime, "hh:nn:ss AM/PM") & vbCrLf & Format$(currentTime, "dd/mm/yyyy") ' '' ' 5. التاريخ فوق الوقت (سطرين) '' timeText = Format$(currentTime, "dd/mm/yyyy") & vbCrLf & Format$(currentTime, "hh:nn:ss AM/PM") ' '' ' 6. الوقت مع اسم اليوم والتاريخ (سطر واحد) '' timeText = Format$(currentTime, "hh:nn:ss AM/PM") & " - " & Format$(currentTime, "dddd, dd/mm/yyyy") ' '' ' 7. التاريخ مع اسم اليوم فقط (سطر واحد) '' timeText = Format$(currentTime, "dddd, dd/mm/yyyy") ' '' ' 8. التاريخ مع اسم اليوم فوق الوقت (سطرين) '' timeText = Format$(currentTime, "dddd, dd/mm/yyyy") & vbCrLf & Format$(currentTime, "hh:nn:ss AM/PM") ' '' ' 9. الوقت فقط مع ثواني بصيغة 24 ساعة '' timeText = Format$(currentTime, "HH:nn:ss") ' '' ' 10. الوقت مع التاريخ مختصر (رقم الشهر بدل اسمه) '' timeText = Format$(currentTime, "hh:nn:ss AM/PM") & vbCrLf & Format$(currentTime, "dd/mm/yy") ' '' ' 11. تنسيق أمريكي (شهر/يوم/سنة) '' timeText = Format$(currentTime, "hh:nn:ss AM/PM") & vbCrLf & Format$(currentTime, "mm/dd/yyyy") ' '' ' 12. مع اسم اليوم والمختصر '' timeText = Format$(currentTime, "hh:nn:ss AM/PM") & vbCrLf & Format$(currentTime, "ddd, dd/mm/yyyy") ' Mon, 15/04/2026 ' '' ' 13. نص مخصص بالكامل '' timeText = "الوقت: " & Format$(currentTime, "hh:nn:ss AM/PM") & vbCrLf & "التاريخ: " & Format$(currentTime, "dddd, dd/mm/yyyy") Dim frm As Object, ctl As Object, target As Object For Each frm In Forms Err.Clear Set target = frm.Controls(TargetControlName) If Err.Number = 0 Then target.Caption = timeText target.Value = timeText End If For Each ctl In frm.Controls Err.Clear Set target = ctl.Form.Controls(TargetControlName) If Err.Number = 0 Then target.Caption = timeText target.Value = timeText End If Next ctl Err.Clear Dim LineS As Object, LineM As Object, LineH As Object Dim CX As Long, CY As Long Dim Radius As Long Set LineS = frm.Controls("LineSec") Set LineM = frm.Controls("LineMin") Set LineH = frm.Controls("LineHour") If Err.Number = 0 Then CX = frm.Controls("Line02").Left + (frm.Controls("Line02").Width / 2) CY = frm.Controls("Line01").Top + (frm.Controls("Line01").Height / 2) Radius = frm.Controls("Line02").Width / 2 Dim secAngle As Double, minAngle As Double, hrAngle As Double secAngle = Second(currentTime) * 6 minAngle = Minute(currentTime) * 6 + (Second(currentTime) * 0.1) hrAngle = (Hour(currentTime) Mod 12) * 30 + (Minute(currentTime) * 0.5) DrawClockHand LineS, CX, CY, CLng(Radius * 0.9), secAngle DrawClockHand LineM, CX, CY, CLng(Radius * 0.75), minAngle DrawClockHand LineH, CX, CY, CLng(Radius * 0.5), hrAngle End If Next frm End Sub Public Sub DrawClockHand(ByRef ctlLine As Object, ByVal CX As Long, ByVal CY As Long, ByVal L As Long, ByVal AngleDeg As Double) Const Pi As Double = 3.14159265358979 Dim Rad As Double Dim EX As Long, EY As Long Rad = AngleDeg * Pi / 180 EX = CX + (L * Sin(Rad)) EY = CY - (L * Cos(Rad)) ctlLine.Width = Abs(EX - CX) ctlLine.Height = Abs(EY - CY) If ctlLine.Width = 0 Then ctlLine.Width = 1 If ctlLine.Height = 0 Then ctlLine.Height = 1 If EX < CX Then ctlLine.Left = EX Else ctlLine.Left = CX If EY < CY Then ctlLine.Top = EY Else ctlLine.Top = CY If Sgn(EX - CX) = Sgn(EY - CY) Or Sgn(EX - CX) = 0 Or Sgn(EY - CY) = 0 Then ctlLine.LineSlant = False Else ctlLine.LineSlant = True End If End Sub Public Sub StartNativeTimer(Optional ByVal IntervalMs As Long = 500) gTimerInterval = IntervalMs If NativeTimerID = 0 Then NativeTimerID = SetTimer(0, 0, IntervalMs, AddressOf NativeTimerCallback) End If If WinEventHookID = 0 Then WinEventHookID = SetWinEventHook(EVENT_SYSTEM_FOREGROUND, EVENT_SYSTEM_FOREGROUND, 0, AddressOf ForegroundChangedProc, 0, 0, WINEVENT_OUTOFCONTEXT) End If End Sub Public Sub StopNativeTimer() If NativeTimerID <> 0 Then KillTimer 0, NativeTimerID NativeTimerID = 0 End If If WinEventHookID <> 0 Then UnhookWinEvent WinEventHookID WinEventHookID = 0 End If End Sub Private Function IsVBEOpen() As Boolean On Error Resume Next IsVBEOpen = Application.VBE.MainWindow.Visible If Err.Number <> 0 Then IsVBEOpen = False On Error GoTo 0 End Function #If VBA7 Then Public Sub ForegroundChangedProc(ByVal hWinEventHook As LongPtr, ByVal eventId As Long, ByVal hWnd As LongPtr, ByVal idObject As Long, ByVal idChild As Long, ByVal dwEventThread As Long, ByVal dwmsEventTime As Long) #Else Public Sub ForegroundChangedProc(ByVal hWinEventHook As Long, ByVal eventId As Long, ByVal hWnd As Long, ByVal idObject As Long, ByVal idChild As Long, ByVal dwEventThread As Long, ByVal dwmsEventTime As Long) #End If On Error Resume Next If AccessHwnd = 0 Then AccessHwnd = Application.hWndAccessApp If IsVBEOpen() Then If NativeTimerID <> 0 Then KillTimer 0, NativeTimerID NativeTimerID = 0 gWasStoppedByVBE = True End If Else If gWasStoppedByVBE Then If GetAncestor(hWnd, GA_ROOT) = AccessHwnd Then If NativeTimerID = 0 Then NativeTimerID = SetTimer(0, 0, gTimerInterval, AddressOf NativeTimerCallback) End If gWasStoppedByVBE = False End If End If End If End Sub وطبعاً الإستدعاء هيكون فقط زي كدة :- Private Sub Form_Load() StartNativeTimer End Sub Private Sub Form_Unload(Cancel As Integer) StopNativeTimer End Sub والملف البسيط ده هدية كبيرة مني لموضوعك المشار إليه نموذج يحتوي فرعي ,, ونموذج رئيسي ، وساعة بالعقارب ورقمية ... Time With No TimerInterval.accdb ودي صورة كمان تخليك تستغرب إن الوقت والساعة شغالين في وضع التصميم لو عاوز .. يعني الحدث عند الوقت ملهوش أي اعتبار عندي هنا . وما تحللش كتير في الكود يا أبو جودي ، هو بسيط و واضح ومقروء ، أصلي ما قرأتش في موضوعك غير جملتين .
  24. طيب لو اخترت ملفك الذي سترفعه لاحصل على الكود المصدري🤔 او انك ستقدم خدمة سحابية😍 انا احترم شغل الاخرين وقد يكون مصدر رزق لهم وقد يكون الحصول على الكود المصدري لبرامجهم عباره عن سرقه. ولو انا مكان الاخ فادي واستطيع استرداد الكود المصدري ساجعله مصدر رزق لي بعد التاكد من ان الملف المرفق هو لصاحب الملف الاصلي ولكن في نفس الوقت متشكك لغايه الان من استرداد الكود المصدري كامل حتى لو اكد الاخ فاد مع احترام الشديد له انه يستطيع ذلك؟
  1. أظهر المزيد
×
×
  • اضف...

Important Information