كل الانشطه

تم معالجة المشكلة ولله الحمد .. 👍🙂 تم نقل الصفحة لموقع آخر يعمل بشكل مجاني .. وهذا هو الرابط الجديد وقد تم تحديثه أيضا في المشاركة الأساسية : https://script.google.com/macros/s/AKfycbwNEw1mNkjqgRndgyLnC89MLYI2C6UiEE-jlRNET0v__nAK377nD8WFkGHnmaTIvxgx/exec

وانا قلت اسبق حضرتك بوضع المثال المثال و المرفق والافكار وصاحبهم ملك يمينك استاذ @منتصر الانسي تدلل لو عند حضرتك نموذج ساعه تانى غير ده ارفق النموذج لاقوم بتطبق الفكرة عليه

كنت على وشك أن أطلب منك تطبيق الحل على مثال لساعة حائطية وجاء الرد قبل أن أطلب رائع 👏👏👏

ما شاء الله .. الله اكبر .. اللهم بارك ايه الجمال والحلاوة دى

تطبيق عملى للفكرة والاكواد على المثال القدبم والمستخدم سابقا فى الموضوع : مطلوب اظهار الساعة تعمل داخل النموذج (الساعة والدقائق والثواني ) من غير استخدام عداد (تايمر) النموذج ClockEngine.zip

مشاركةً مع استاذي @ابو جودي تفضل استاذ @بلال بلال الشرح والمرفق حسب مافهمت . ووافني بالرد . قاعدة بيانات- بلال.rar

السلام عليكم ورحمة الله تعالى وبركاته بادئ ذي بدء هذا الموضوع يعد مهما وحيويا لمصممي ومطوري النظم أكثر من المستخدم العادي جاءت فكرة هذا الموضوع بناء على موضوع سابق كان بعنوان: مطلوب إظهار الساعة تعمل داخل النموذج (الساعة والدقائق والثواني) من غير استخدام عداد (تايمر) النموذج ومن أهم ما ورد فيه هذا الاقتباس: في الموضوع السابق كانت الفكرة تمثل حلا تقليديا لأنها اعتمدت على Timer آخر للمراقبة وهذا لم يكن مناسبا لأنه يظل يعمل أثناء تعديل الأكواد داخل محرر VBA لكن بفضل الله سبحانه وتعالى توصلت إلى حل مختلف تماما يعتمد على: TimerInterval الخاص بالنموذج نفسه مراقبة ظهور واختفاء محرر VBA استخدام Hook عند تغيير النافذة النشطة بدلا من الاعتماد على Timer إضافي فكرة العمل باختصار عند فتح النموذج يبدأ TimerInterval إذا تم فتح محرر VBA يتم إيقاف التايمر فورا عند إغلاق المحرر والعودة إلى نماذج قاعدة البيانات المفتوحة يتم تشغيل التايمر من جديد تلقائيا وفورا لا حاجة لتمرير اسم النموذج الرئيسي أو اسم عنصر الـ Subform يدويا لأن الكود يكتشف ذلك تلقائيا المطلوب فقط هو تمرير اسم عنصر التحكم الذي سيتم عرض الوقت فيه أيا كان نوعه: Label أو TextBox مميزات الحل يعمل مع النموذج الرئيسي أو المستقل يعمل مع النموذج الفرعي يعمل مع أكثر من نموذج في نفس الوقت يدعم عنصر العرض سواء كان Label أو TextBox لا يعتمد على Timer إضافي للمراقبة الوحدة النمطية العامة باسم : basSmartClock Option Compare Database Option Explicit #If VBA7 Then 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 #Else 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 #End If Private Const CLOCK_INTERVAL_MS As Long = 1000 Private Const EVENT_SYSTEM_FOREGROUND As Long = &H3 Private Const WINEVENT_OUTOFCONTEXT As Long = &H0 Private Const GA_ROOT As Long = 2 Private gHook As LongPtr Private gAccessHwnd As LongPtr Private gClocks As Object Private Sub EnsureClockStore() If gClocks Is Nothing Then Set gClocks = CreateObject("Scripting.Dictionary") End If End Sub Private Function MakeClockKey(frm As Access.Form) As String On Error GoTo EH Dim p As Access.Form Dim ctlName As String Set p = frm.Parent ctlName = GetSubformControlName(p, frm) If Len(ctlName) > 0 Then MakeClockKey = p.Name & "|" & ctlName & "|" & frm.Name Exit Function End If EH: MakeClockKey = frm.Name End Function Private Function CreateClockState(frm As Access.Form, ByVal ClockControlName As String) As Object Dim d As Object Set d = CreateObject("Scripting.Dictionary") Dim isSub As Boolean Dim parentName As String Dim subCtlName As String On Error Resume Next parentName = frm.Parent.Name subCtlName = GetSubformControlName(frm.Parent, frm) isSub = (Len(subCtlName) > 0) On Error GoTo 0 d.Add "Key", MakeClockKey(frm) d.Add "HostFormName", frm.Name d.Add "ParentFormName", parentName d.Add "SubformControlName", subCtlName d.Add "IsSubform", isSub d.Add "ClockControlName", ClockControlName d.Add "WasStoppedByVBE", False Set CreateClockState = d End Function Public Sub StartSmartClock(frm As Access.Form, ByVal ClockControlName As String) On Error GoTo EH EnsureClockStore Dim key As String Dim state As Object key = MakeClockKey(frm) If gClocks.Exists(key) Then gClocks.Remove key End If Set state = CreateClockState(frm, ClockControlName) gClocks.Add key, state frm.TimerInterval = CLOCK_INTERVAL_MS If gAccessHwnd = 0 Then gAccessHwnd = Application.hWndAccessApp End If If gHook = 0 Then gHook = SetWinEventHook( _ EVENT_SYSTEM_FOREGROUND, _ EVENT_SYSTEM_FOREGROUND, _ 0, _ AddressOf ForegroundChangedProc, _ 0, _ 0, _ WINEVENT_OUTOFCONTEXT) End If Exit Sub EH: End Sub Public Sub StopSmartClock(frm As Access.Form) On Error Resume Next EnsureClockStore Dim key As String key = MakeClockKey(frm) frm.TimerInterval = 0 If gClocks.Exists(key) Then gClocks.Remove key End If If gClocks.Count = 0 Then If gHook <> 0 Then UnhookWinEvent gHook gHook = 0 End If Set gClocks = Nothing End If End Sub Public Sub SmartClockTimer(frm As Access.Form) On Error Resume Next EnsureClockStore Dim key As String Dim state As Object key = MakeClockKey(frm) If Not gClocks.Exists(key) Then Exit Sub Set state = gClocks(key) If Application.VBE.MainWindow.Visible Then state("WasStoppedByVBE") = True frm.TimerInterval = 0 Exit Sub End If SetClockDisplay frm, state("ClockControlName"), Format$(Now(), "dd/mm/yyyy, hh:nn:ss AM/PM") End Sub Private Sub SetClockDisplay(frm As Access.Form, ByVal ClockControlName As String, ByVal ClockText As String) On Error Resume Next Dim ctl As Access.Control Set ctl = frm.Controls(ClockControlName) If ctl Is Nothing Then Exit Sub Select Case ctl.ControlType Case acTextBox ctl.Value = ClockText Case acLabel ctl.Caption = ClockText End Select End Sub Private Function GetSubformControlName(parentFrm As Access.Form, childFrm As Access.Form) As String On Error Resume Next Dim ctl As Access.Control For Each ctl In parentFrm.Controls If ctl.ControlType = acSubform Then If ctl.Form Is childFrm Then GetSubformControlName = ctl.Name Exit Function End If End If Next ctl End Function Private Function GetStateTargetForm(state As Object, ByRef frm As Access.Form) As Boolean On Error GoTo EH If state("IsSubform") Then If (SysCmd(acSysCmdGetObjectState, acForm, state("ParentFormName")) And acObjStateOpen) = 0 Then Exit Function Set frm = Forms(state("ParentFormName")).Controls(state("SubformControlName")).Form Else If (SysCmd(acSysCmdGetObjectState, acForm, state("HostFormName")) And acObjStateOpen) = 0 Then Exit Function Set frm = Forms(state("HostFormName")) End If GetStateTargetForm = Not (frm Is Nothing) Exit Function EH: Set frm = Nothing 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 gClocks Is Nothing Then Exit Sub If gClocks.Count = 0 Then Exit Sub If GetAncestor(hwnd, GA_ROOT) <> gAccessHwnd Then Exit Sub Dim k As Variant Dim state As Object Dim frm As Access.Form For Each k In gClocks.Keys Set state = gClocks(k) If state("WasStoppedByVBE") Then If GetStateTargetForm(state, frm) Then frm.TimerInterval = CLOCK_INTERVAL_MS SetClockDisplay frm, state("ClockControlName"), Format$(Now(), "dd/mm/yyyy, hh:nn:ss AM/PM") state("WasStoppedByVBE") = False End If End If Next k End Sub مثال الاستدعاء إذا كان العرض داخل Label Option Compare Database Option Explicit Private Sub Form_Open(Cancel As Integer) StartSmartClock Me, "lblClock" End Sub Private Sub Form_Timer() SmartClockTimer Me End Sub Private Sub Form_Unload(Cancel As Integer) StopSmartClock Me End Sub مثال الاستدعاء إذا كان العرض داخل TextBox Option Compare Database Option Explicit Private Sub Form_Open(Cancel As Integer) StartSmartClock Me, "txtDClock" End Sub Private Sub Form_Timer() SmartClockTimer Me End Sub Private Sub Form_Unload(Cancel As Integer) StopSmartClock Me End Sub كما تلاحظون كود الاستدعاء هو نفسه لأي نموذج سواء كان: رئيسيا فرعيا منفردا أو أكثر من نموذج معا إذا كان عرض الوقت داخل النموذج يعتمد على عنصر من النوع: Label إذا كان عرض الوقت داخل النموذج يعتمد على عنصر من النوع: TextBox كل المطلوب فقط هو تمرير اسم عنصر التحكم المستخدم في عرض الوقت ايا كان نوعه ( Label/TextBox ) : StartSmartClock Me, "اسم_عنصر_التحكم" وفى النهاية أسأل الله أن ينفع به إذا كان لدى أحد الأساتذة العظماء أو الإخوة الكرام أي ملاحظة على الكود أكون شاكرا جدا. مع خالص التحية SmartClock.accdb

أتمنى من خبراء الـ VBA مساعدتي في إخراج هذا العمل بشكل "رائع" يليق بمستوى هذا المنتدى العريق. شكراً جزيلاً لكم مسبقاً.

برمجة اكسل.xlsبرمجة اكسل.xlsm السلام عليكم ورحمة الله وبركاته، إخواني الخبراء في منتدى أوفيسنا، تحية طيبة وبعد.. أعمل حالياً على تطوير نظام لإدارة بيانات مركز ترفيهي يحتوي على عدة مناطق (نسيم، حديقة، حميدة). قمت بتصميم واجهة إدخال يدوية ، ولكنني أطمح لتحويلها إلى UserForm احترافي وشامل، بالإضافة إلى بناء نظام تقارير وإحصاءات.و اضافة الالعاب في المناطق الثلاثة المطلوب من كرمكم: واجهة إدخال (UserForm): تصميم فورم يجمع كافة الخانات الموجودة في الواجهة (قونفلابل، قطار، طومبناج، عدد العمال.. إلخ). منع تكرار التاريخ: أرغب في كود ذكي يقوم بالبحث في ورقة (Data) قبل الترحيل؛ فإذا كان التاريخ مسجلاً مسبقاً يقوم بـ "تحديث" البيانات بدلاً من تكرار السطر. نظام تقارير وإحصاء: إضافة ميزة لاستخراج إحصائيات يومية أو شهرية بناءً على البيانات المخزنة في ورقة (Data). جمالية التصميم: يفضل أن تكون الألوان متناسقة واحترافية (ألوان هادئة وتدرجات تليق بنظام إداري).

وهذا المرفق فى حالة وضع الكود فى وحدة نمطية عامة لاستخدامة فى اكثر من نموذج ComboDropdown_V2.accdb

انا مش فاهم السؤال كويس لكن بقدر الامكان حسب فهمى المتواضع استخدم الكود التالى اما على مستوى النموذج او فى وحدة عامة Private m_LastForm As String Private m_LastCombo As String Public Function ToggleDropdCombo(frm As Form, ByVal strObjComboName As String) As Boolean On Error GoTo Err_Handler Dim strObjButtonName As String strObjButtonName = Screen.ActiveControl.Name If m_LastForm = frm.Name And m_LastCombo = strObjComboName Then frm.Controls(strObjButtonName).SetFocus GoTo Clean_Exit Else frm.Controls(strObjComboName).SetFocus frm.Controls(strObjComboName).Dropdown m_LastForm = frm.Name m_LastCombo = strObjComboName End If ToggleDropdCombo = True Exit Function Reset_Exit: Clean_Exit: m_LastForm = vbNullString m_LastCombo = vbNullString ToggleDropdCombo = True Exit Function Err_Handler: m_LastForm = vbNullString m_LastCombo = vbNullString MsgBox Err.Description, vbExclamation, "ToggleDropdCombo" ToggleDropdCombo = False End Function على اعتبار ان زر الامر اسمه : ToggleButtonName وان مربع السرد اسمه : ComboName يكون الاستدعاء بالشكل التالى Private Sub ToggleButtonName_Click() ToggleDropdCombo Me, "ComboName" End Sub ويستخدم نفس سطر الاستدعاء السابق مع زر أخر ومربع تحرير وسرد اخر فقط بتغير : ComboName الى اسم مربع التحرير والسرد الاخر مرفق للتجربة ComboDropdown.accdb

السلام عليكم لدي نموذج فرعي فيه اريد عند وضع الماوس أم الزر تظهر القائمة المسندلة اليكم الصورة فيها الشرح 1 قاعدة بيانات.accdb _1146714590913439_8483909941377199527_n.bmp

هل توقف عمل البرنامج VBA CODE DOCTOR حاولت استخدمة و لكن تلك الرسالة الدائمة حتى بعد التكرار Error: Server Error The server encountered an error and could not complete your request. Please try again in 30 seconds. منتظر الرد

انا وجدت معادله بالبحث عنها ولكن توزع على مدار الاسبوع كاملا حتى لو اليوم لا يوجد به حصص فيمكن تعديلها لتلبية المطلوب =if( mod(m7,5)>0,Mod (M7/5)+1,Mod (M7/5)

تسلم وكلك ذوق يا غالي ربنا يهديلكم الاحوال ويهدينا جميعا لما يحبه ويرضاه

والله أجمل حاجة فيك يا ممدوح - ومن غير ما تزعل - هي صراحتك اللي بعرفها من أيام المجموعة يا فنان .. وبعدين انت بتتكلم عن ايه بالظبط هنا :- ما فيش حاجة أصلاً صدقني .. ده مجرد نكاش وهزار برمجي 😂

انا بحبكم انتم الاتنين وبعزكم فالله واللي بيعرفني فيكم كويس او لما كنت بخش علي جروب الواتس يعرف اني مدب ومبعرفش اجامل وفنفس الوقت حتي لما بختلف مع حد مبهاجمش بالعكس ببعد ( مش ضعف او هروب ) خالص دا لملاشاه الاحتكاك اولا وفنفس الوقت لان مينفعش الحب يتبدل كرهه او اسفاف والإ كان يبقي نفاق من الاول ثانيا وثالثا واخيرا زي مالناس بتتعلم منكم ومن اراءكم هتتعلم من اسلوبكم ده برضو راجعون نفسكم واسف عالاطاله

ما تشغلش بالك بيه انا صحتى كويسه الحمد لو ده أسلوبك في الذكاء فأعتقد النتيجة وصلت لوحدها .. ما تقلق اللي عنده ثقل في الكلام مش بيحتاج أسبرين بيحتاج ذوق هى اصلها مش بتمشى بالتجارب يا عسل وزيك زيه ليكم عندى النصيحة وانتم احرار انا وضعت نصيحة لوجه الله تعالى وانتم احرار اللى شايفها بتوجع وعاوز يعمل نفسه اسبرين هو حر واللى شايفها بالتجارب يعيش واللى شايفها استعراض هو حر هو كمان يشوف بمزاجه مجرد نصيحة و ابرئت زمتى امام الله فقط

السادة الافاضل الرجاء عمل كود بحيث يتم استدعاء البيانات الموجودة في الشتات من 1 الي 6 في الشيت خطة الاحتياجات مجمـــــــع للمدارس ابريل 2026 بحيث يكون الكود مفتوح لعدد 150شيت او اكثر عمل كود استدعاء لاكثر من شيت.rar

أما إن كان كلامك نابع من هذه المشاركة :- ولو عاوز كامل المحادثة أرفقها برضو ، فأنا سأقوم بإرفاق نفس الملف اللي بعتهولك وهو من فكرة انت طرحتها ، وانا كنت استعملت أسلوب التشفير والتشويش لو صح التعبير على ملفك اللي انت شاركت بيه ، ويبدو إن الفكرة عجبتك لدرجة إنك ما قدرتش تفك التشفير - رغم أن الأكواد قدامك - لكنها متشفرة . أما موضوع السطر اللي انت مسكت بيه وهو كان خيطك الوحيد علشان تحاول تشوه سمعتي على الملأ . فهو مجرد واحد من مجموعة أكواد لا تعطي أي نتيجة سوى أنها تخلي أي شخص متلك يروح لحتى تانية انا رسمتهاله ( فاكر ) ، وحددتله أني عايزه يروح ليها .. يعني أمشيك بالكود على مزاجي . وحقيقة عبارتك فإنت متعب نفسك ليه ورايح وجاي وبتلف مع نفسك .. خليك شجاع وما تحاولش تجرب أي ملف أنا برفقه ، ده لو الفضول ما قتلش فيك حته كدة ولا كدة . وفيما يلي ، مقطع مصور للفكرة اللي شاركتها مع الإنسان محمد عصام ولا أياً كان اسمه الحقيقي . وحقيقة التشويش والتشفير اللي عملته 😏 وهذا الرد للمشرفين فقط علشان تكون الأمور أوضح . مع أني لست مطالب بتوضيح أو تبرير ، ولكني أمام الله قد برأت ذمتي مع أفكاري أمامكم . صلاحيات 2026.zip

مجهود احترافي وعالى وليس غريب عليك اخ فادي الا اني بعمل علي اصدار ٣٣ لي بس بعض الملاحظات الصغيره كهاوي فيما يخص القاعده :- كتير ممكن يحاول الغش او اخذ حقوق الاخرين في قواعد البيانات المغلقه للتحربه او لحقوق الملكيه فيما يخص الدنيا :- ودي مش لك لوحدك لك وللمهندس محمد عصام ...ولنفسي قبلكم فهي فانيه ولا تساوي جناح بعوضه لا حاجه لنا لاستعراض عضلات او للضغينه او للمشاحنات فالعلم إن لم يكن محاط بالتواضع والأخلاق لا فائده له

بالفعل هذا ما أريده وهو عدد الحصص الزياده عن نصابة . بحيث يتم توزيع حصص الزيادة على مدار الاسبوع .فلو كان له ٣ ايام حضور في الأسبوع يتم توزيع ٣ حصص على ٣ايام واذا كان حضوره على مدار الاسبوع يتم التوزيع على مدار الاسبوع .وبفرض عدد الحصص ٦ والاسبوع ٥ ايام حضور يكون التوزيع كل يوم ١ حصة ويوم ٢ حصه مثال للتوضيح مثال للتوضح والمطلوب.xlsm

مباااادرة جميلة وجيدة ، على الأقل نراكم ونسعد بمواضيعكم أينما حللتم

للأسف .. لم أفهم المطلوب نهائياً !! يعني مثلاً انت تريد تقسيم العدد 3 الموجود في الخلية N9 على الخلايا من M10 - M14 ؟؟؟؟؟؟؟ لو فعلاً ما تقصده ، فعلى أي أساس ؟؟ وما الشروط ؟؟ وكيف تريد التنفيذ 🤷🏻‍♂️

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