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

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

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

السلام عليكم ورحمة الله تعالى وبركاته بادئ ذي بدء هذا الموضوع يعد مهما وحيويا لمصممي ومطوري النظم أكثر من المستخدم العادي جاءت فكرة هذا الموضوع بناء على موضوع سابق كان بعنوان: مطلوب إظهار الساعة تعمل داخل النموذج (الساعة والدقائق والثواني) من غير استخدام عداد (تايمر) النموذج ومن أهم ما ورد فيه هذا الاقتباس: 1- 2-وهذا الاقتباس: في الموضوع السابق كانت الفكرة تمثل حلا تقليديا لأنها اعتمدت على 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

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

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

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

اعرض الملف لعشاق كرة القدم (ملف أكسل لإحتساب نتائج كأس العالم 2026) رغم أني لا أنشط إلا في منتدى أكسس إلا أني اليوم قررت أن أرفق لكم ملف أكسل جميل كان قد أرسله لي شقيقي الأصغر هشام بعد أن وجده في أحد المواقع الأجنبيه وقام بتعريبه ووضع بعض التحسينات عليه وقد إستأذنته في رفعه إلى المنتدى ووافق بكل سرور كل ما عليكم هو إدخال النتائج في الورقة Match Results وسيقوم أكسل ببقية العمل أرجو أن ينال العمل إستحسانكم وإذا كان هناك أي ملاحظات فلا تتردوا في ذكرها تحياتي صاحب الملف منتصر الانسي تمت الاضافه 04/11/26 الاقسام قسم الإكسيل

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

بارك الله فيك أستاذ منتصر وجزاك الله خير الثواب وجعله اله فى ميزان حسناتك

الفكرة رقم ( 2 ) عند الضغط على زر الامر تظهر الصورة عند الضغط على الصورة يفتح نموذج لتكبير الصورة عند الضغط على الصورة فى نموج يتم تكبير الصورة عند اعادة الضغط مرة أخرى على الصورة يتم استعادة الحجم الاصلى للصورة صورة قاعدة بيانات 02.zip

أخي @بلانك ، بعد السلام عليكم ورحمة الله وبركاته .. الأصل ان ترفق ملفك غير محمي بكلمة مرور لمحرر الأكواد . نظراً لأن العمل لن يكون في المعادلات كونك تستعمل الدائرة Shape . لذا ترفق بنا فيما بعد لتلافي هذا الخطأ أيضاً عليك اختيار عنوان صحيح وذو دلالة للمطلوب . وليس عنواناً مبهماً استفسارياً ، حتى لا يتعرض موضوعك للإغلاق مخالفاً لقواعد المشاركات .. وعليه ومن خلال النظر للملف ودون محاولة مني لكسر حمايته ، جرب الدالة التالية واستدعيها في زر خاص بها :- Sub CountShapesPerRow() Dim ws As Worksheet Dim shp As Shape Dim r As Long Dim countRow(10 To 14) As Integer Dim countRow2(18 To 22) As Integer Set ws = ThisWorkbook.Sheets("Sheet1") For Each shp In ws.Shapes For r = 10 To 14 If Not Intersect(ws.Range("C" & r & ":J" & r), shp.TopLeftCell) Is Nothing Then countRow(r) = countRow(r) + 1 End If Next r For r = 18 To 22 If Not Intersect(ws.Range("C" & r & ":J" & r), shp.TopLeftCell) Is Nothing Then countRow2(r) = countRow2(r) + 1 End If Next r Next shp For r = 10 To 14 ws.Range("M" & r).Value = countRow(r) Next r For r = 18 To 22 ws.Range("M" & r).Value = countRow2(r) Next r End Sub ما لم تفلح معك الفكرة ، اعد رفع الملف بدون حماية محرر الأكواد إذا تكرمت .

يوجد برامج مخازن جاهزة مثل هذا البرنامج إعداد الأستاذ رفيق أحمد و يوفر لك الوقت و الجهد كلمة السر: 1280 و برنامج آخر مفتوح المصدر للمخازن و الحساباتبرنامج ادارة المخازن والمشتريات ver.3.0.xlsb برنامج ادارة المخازن والمشتريات ver.3.0.xlsb ادارة الحسابات والمخزون .xlsm

بارك الله فيك هذا هو الفضل وزيادة .جمعة مباركة عليك

وعليكم السلام ورحمة الله وبركاته بالنسبة للاوقات التي خارج الاوقات في M&N لم تحدده وفي اي بصمة تسجل تم ربط المعادلات حسب الاوقات في M&N اكسل1.xlsm

ممتاز ما قمت به . اكمل ما تريده ل 30 جدول و نشوف النتيجة النهائية بإذن الله

وعليكم السلام ورحمة الله وبركاته جرب التعديل بالملف اكسل.xlsm

جمعت الحلين في مثال واحد واضطررت لحذف كل الأكواد المتعلقة بحل الأستاذ عسل قليل الدسم مع الاعتذار لمزيد من التركيز للسائلة. تجربة صادر_05.accdb

تفضل استاذ @AhmedEmam حصلت لك مرفق من مكتبي . اليك الشرح والمرفق . أكتب طلبك وانا بعدل أي شئ تريده . ووافني بالرد . ChangeAllFormsColor.rar

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

أخي فوكش شكرا على التوضيح والتنبيه لم اقصد فعلا العنوان خطأ مني بسبب احتفاظ المتصفح باسئلة سابقة. ليس حساب عدد الدوائر بل تقسيم العدد في N9 و N17 لعمل الدوائر ..... وهذا هو الملف بدون حماية ..... اما كود حضرتك فهو يحسب عدد الدوائر وانا لا أريد ذلك فالعدد مكتوب اصلا في الخليتين كما ذكرت N9 و N17 والمطلوب العكس تقسم العدد الموجود في الخليتين السابق ذكراهما لعمل الدوائر حول الجصص الزيادة لكل مدرس ...... ارجو بأني قد اوضحت الفكرةولو أطمع من كرم حضرتك ان تكون بالمعادلات حتى يتسنى لي نقلهما الى ملف اخر ..... وشكرا على التبيه ... وجزاك الله كل الخير الاستمارة ك بدون خمياية.xlsm