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

كل الانشطه

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

  1. الساعة الأخيرة
  2. اعرض الملف Clock With Smart Timer هذا الموضوع يعد مهماً وحيوياً لمصممي ومطوري النظم أكثر من المستخدم العادي خاصة عند استخدام حدث Timer مع أي نموذج ويريد مطور النظام فتح محرر الأكواد (VBA) في نفس وقت عرض النماذج هنا تحدث المشكلة الكلاسيكية: المطور لا يستطيع تعديل أي كود لأن التايمر النموذج يعطل التركيز داخل المحرر و يسبب أخطاء بفضل هذه الفكرة الثورية هذا الأمر أصبح من الماضي السحيق فكرة العمل باختصار 1 - عند فتح النموذج يبدأ TimerInterval تلقائياً 2 - إذا تم فتح محرر VBA بأى طريقة كانت يتم إيقاف التايمر فوراً 3 - عند إغلاق المحرر والعودة إلى النماذج يتم تشغيل التايمر من جديد تلقائياً وفوراً 4 - لا حاجة لتمرير اسم النموذج الرئيسي أو اسم عنصر الـ Subform يدوياً 5 - المطلوب فقط هو تمرير اسم عنصر التحكم الذي سيتم عرض الوقت فيه (Label أو TextBox) حسب الحاجة والرغبة مميزات الحل ذكـي : يكتشف النموذج الرئيسي والفرعي تلقائياً متعدد : يعمل مع أكثر من نموذج في نفس الوقت مـــرن : يدعم Label و TextBox كعناصر عرض للوقت آمـــن : إذا تم حذف الوحدة النمطية يتحول تلقائياً إلى Fallback Mode باستخدام دالة الوقت الرئيسية : Now() خفيف : لا يعتمد على Timer إضافي للمراقبة جاهــز : يعمل مع النماذج الرئيسية و الفرعية أو الرئيسية المستقلة أو الرئيسية والفرعية معا ----------------------------------------------------- الوحدة النمطية العامة الاسم المقترح: basClockManager الكود... 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 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 ErrorHandler Dim vParentForm As Access.Form Dim vControlName As String Set vParentForm = frm.Parent vControlName = GetSubformControlName(vParentForm, frm) If Len(vControlName) > 0 Then MakeClockKey = vParentForm.Name & "|" & vControlName & "|" & frm.Name Exit Function End If ErrorHandler: MakeClockKey = frm.Name End Function Private Function CreateClockState(frm As Access.Form, _ ByVal pControlName As String, _ ByVal pIntervalMS As Long) As Object Dim vState As Object Set vState = CreateObject("Scripting.Dictionary") Dim vIsSubform As Boolean Dim vParentName As String Dim vSubCtlName As String On Error Resume Next vParentName = frm.Parent.Name vSubCtlName = GetSubformControlName(frm.Parent, frm) vIsSubform = (Len(vSubCtlName) > 0) On Error GoTo 0 vState.Add "Key", MakeClockKey(frm) vState.Add "HostFormName", frm.Name vState.Add "ParentFormName", vParentName vState.Add "SubformControlName", vSubCtlName vState.Add "IsSubform", vIsSubform vState.Add "ControlName", pControlName vState.Add "WasStoppedByVBE", False vState.Add "IntervalMS", pIntervalMS Set CreateClockState = vState End Function Public Sub StartSmartClock(frm As Access.Form, _ ByVal pControlName As String, _ Optional ByVal pIntervalMS As Long = 1000) On Error GoTo ErrorHandler EnsureClockStore Dim vKey As String Dim vState As Object vKey = MakeClockKey(frm) If gClocks.Exists(vKey) Then gClocks.Remove vKey Set vState = CreateClockState(frm, pControlName, pIntervalMS) gClocks.Add vKey, vState frm.TimerInterval = pIntervalMS If gAccessHwnd = 0 Then gAccessHwnd = Application.hWndAccessApp If gHook = 0 Then gHook = SetWinEventHook( _ EVENT_SYSTEM_FOREGROUND, _ EVENT_SYSTEM_FOREGROUND, _ 0, _ AddressOf ForegroundChangedProc, _ 0, 0, _ WINEVENT_OUTOFCONTEXT) End If Exit Sub ErrorHandler: End Sub Public Sub StopSmartClock(frm As Access.Form) On Error Resume Next EnsureClockStore Dim vKey As String vKey = MakeClockKey(frm) frm.TimerInterval = 0 If gClocks.Exists(vKey) Then gClocks.Remove vKey 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 vKey As String Dim vState As Object vKey = MakeClockKey(frm) If Not gClocks.Exists(vKey) Then Exit Sub Set vState = gClocks(vKey) If IsVbeOpen() Then vState("WasStoppedByVBE") = True frm.TimerInterval = 0 Exit Sub End If Dim vTimeText As String vTimeText = Format$(Now(), "dd/mm/yyyy hh:nn:ss AM/PM") If Len(vState("ControlName")) > 0 Then UpdateControlDisplay frm, vState("ControlName"), vTimeText 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 Private Sub UpdateControlDisplay(frm As Access.Form, ByVal pControlName As String, ByVal pDisplayText As String) On Error Resume Next Dim vControl As Access.Control Set vControl = frm.Controls(pControlName) If vControl Is Nothing Then Exit Sub Select Case vControl.ControlType Case acTextBox If vControl.Value <> pDisplayText Then vControl.Value = pDisplayText End If Case acLabel If vControl.Caption <> pDisplayText Then vControl.Caption = pDisplayText End If End Select End Sub Private Function GetSubformControlName(vParentForm As Access.Form, vChildForm As Access.Form) As String On Error Resume Next Dim vControl As Access.Control For Each vControl In vParentForm.Controls If vControl.ControlType = acSubform Then If vControl.Form Is vChildForm Then GetSubformControlName = vControl.Name Exit Function End If End If Next vControl End Function Private Function GetStateTargetForm(vState As Object, ByRef vForm As Access.Form) As Boolean On Error GoTo ErrorHandler If vState("IsSubform") Then If (SysCmd(acSysCmdGetObjectState, acForm, vState("ParentFormName")) And acObjStateOpen) = 0 Then Exit Function Set vForm = Forms(vState("ParentFormName")).Controls(vState("SubformControlName")).Form Else If (SysCmd(acSysCmdGetObjectState, acForm, vState("HostFormName")) And acObjStateOpen) = 0 Then Exit Function Set vForm = Forms(vState("HostFormName")) End If GetStateTargetForm = Not (vForm Is Nothing) Exit Function ErrorHandler: Set vForm = 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 vKey As Variant Dim vState As Object Dim vForm As Access.Form For Each vKey In gClocks.Keys Set vState = gClocks(vKey) If vState("WasStoppedByVBE") Then If GetStateTargetForm(vState, vForm) Then vForm.TimerInterval = vState("IntervalMS") Dim vTimeText As String vTimeText = Format$(Now(), "dd/mm/yyyy hh:nn:ss AM/PM") If Len(vState("ControlName")) > 0 Then UpdateControlDisplay vForm, vState("ControlName"), vTimeText End If vState("WasStoppedByVBE") = False End If End If Next vKey End Sub ----------------------------------------------------- طريقة الاستدعاء في النماذج نموذج يعرض الوقت في Label الكود... Private Sub Form_Load() Application.Run "StartSmartClock", Me, "lblTime", 1000 End Sub Private Sub Form_Timer() Application.Run "SmartClockTimer", Me End Sub Private Sub Form_Unload(Cancel As Integer) Application.Run "StopSmartClock", Me End Sub ----------------------------------------------------- نموذج يعرض الوقت في TextBox الكود... Private Sub Form_Load() Application.Run "StartSmartClock", Me, "txtTime", 1000 End Sub Private Sub Form_Timer() Application.Run "SmartClockTimer", Me End Sub Private Sub Form_Unload(Cancel As Integer) Application.Run "StopSmartClock", Me End Sub ----------------------------------------------------- نموذج بدون عرض نصي للوقت الكود... Private Sub Form_Load() Application.Run "StartSmartClock", Me, "", 1000 End Sub Private Sub Form_Timer() Application.Run "SmartClockTimer", Me End Sub Private Sub Form_Unload(Cancel As Integer) Application.Run "StopSmartClock", Me End Sub ----------------------------------------------------- كما تلاحظون الاستدعاء سهل وموحد سواء أردنا عرض الوقت في TextBox أو Label Application.Run "StartSmartClock", Me, "", 1000 ملاحظة هامة حول معامل : TimerInterval وهو المعامل الثالث فى الاستدعاء (Interval) الرقم: 1000 هو قيمة TimerInterval يمثل الفاصل الزمني بالميلي ثانية القيمة الافتراضية : 1000 (ثانية واحدة) تم ضبطها مسبقاً داخل الوحدة النمطية هل هو إجباري؟ لايمكن حذفه والاعتماد على القيمة الافتراضية طرق الاستدعاء المختلفة مع المعامل : ' الطريقة الأولى: تمرير قيمة مخصصة (مثلاً نصف ثانية) Application.Run "StartSmartClock", Me, "lblTime", 500 ' الطريقة الثانية: حذف المعامل (يتم استخدام 1000 تلقائياً) Application.Run "StartSmartClock", Me, "lblTime" في بعض الحالات قد يرغب المصمم في عمل التالى : ساعة عادية لذلك سوف تكون قيمة : TimerInterval =1000 (ثانية واحدة) ساعة دقيقة (Stopwatch) تكون قيمة TimerInterval = 100 (جزء من الثانية) ساعة بطيئة (تحديث نادر) تكون قيمة TimerInterval = 5000 (5 ثوانٍ) لهذا السبب تم جعل هذا المعامل اختيارياً مع استخدام القيمة الإفتراضية المنطقية مع إتاحة المجال للمصمم لتغييره حسب احتياجاته ----------------------------------------------------- نموذج مع Fallback ( منتهى الأمان ) الكود... Option Compare Database Option Explicit Private mIsSmartClockActive As Boolean Private Sub Form_Load() AttemptStartSmartClock End Sub Private Sub Form_Timer() Dim vTimeText As String vTimeText = Format$(Now(), "dd/mm/yyyy hh:nn:ss AM/PM") If mIsSmartClockActive Then Application.Run "SmartClockTimer", Me Me.txtDClock = vTimeText Else ' Fallback: النموذج يحدث نفسه بنفسه Me.txtDClock = vTimeText Me.lblDClock.Caption = vTimeText End If End Sub Private Sub Form_Unload(Cancel As Integer) On Error Resume Next If mIsSmartClockActive Then Application.Run "StopSmartClock", Me End If Me.TimerInterval = 0 On Error GoTo 0 End Sub Private Sub AttemptStartSmartClock() On Error GoTo FallbackMode Application.Run "StartSmartClock", Me, "lblDClock", 1000 mIsSmartClockActive = True Exit Sub FallbackMode: Err.Clear mIsSmartClockActive = False Me.TimerInterval = 1000 End Sub ----------------------------------------------------- الخلاصة النهائية :الاستدعاء المناسب عرض الوقت في : Label LabelStartSmartClock Me, "lblTime" عرض الوقت في : TextBox StartSmartClock Me, "txtTime" بدون عرض نصى للوقت مثلا : ساعة عقارب (بدون عرض نصي) StartSmartClock Me, "" نموذج فرعي (Subform) نفس الكود - يتم اكتشافه تلقائياً نماذج متعددة في نفس الوقت مدعوم بالكامل ملاحظات مهمة إعدادات الأمان : يجب تفعيل Trust access to the VBA project object model في إعدادات Trust Center إصدار Access : يعمل مع Access 2007 والإصدارات الأحدث مراجع إضافية : لا يحتاج إلى إضافة أي مراجع Fallback Mode : إذا تم حذف الوحدة النمطية، يتحول النموذج تلقائياً إلى استخدام Now() مع هذا الحل الفريد أصبح : التحكم في TimerInterval أثناء فتح محرر VBA أمراً تلقائياً بالكامل، دون أي تدخل يدوي أو تعقيدات سهولة فتح محرر VBA و إضافة أو تعديل أى أكواد في نفس وقت عرض النماذج وبدون أن تحدث المشكلة الكلاسيكية بسبب : TimerInterval استمتع بتجربة تطوير سلسة وخالية من المشاكل صاحب الملف ابو جودي تمت الاضافه 04/15/26 الاقسام قسم الأكسيس  
  3. Version 1.0.1

    0 تنزيل

    هذا الموضوع يعد مهماً وحيوياً لمصممي ومطوري النظم أكثر من المستخدم العادي خاصة عند استخدام حدث Timer مع أي نموذج ويريد مطور النظام فتح محرر الأكواد (VBA) في نفس وقت عرض النماذج هنا تحدث المشكلة الكلاسيكية: المطور لا يستطيع تعديل أي كود لأن التايمر النموذج يعطل التركيز داخل المحرر و يسبب أخطاء بفضل هذه الفكرة الثورية هذا الأمر أصبح من الماضي السحيق فكرة العمل باختصار 1 - عند فتح النموذج يبدأ TimerInterval تلقائياً 2 - إذا تم فتح محرر VBA بأى طريقة كانت يتم إيقاف التايمر فوراً 3 - عند إغلاق المحرر والعودة إلى النماذج يتم تشغيل التايمر من جديد تلقائياً وفوراً 4 - لا حاجة لتمرير اسم النموذج الرئيسي أو اسم عنصر الـ Subform يدوياً 5 - المطلوب فقط هو تمرير اسم عنصر التحكم الذي سيتم عرض الوقت فيه (Label أو TextBox) حسب الحاجة والرغبة مميزات الحل ذكـي : يكتشف النموذج الرئيسي والفرعي تلقائياً متعدد : يعمل مع أكثر من نموذج في نفس الوقت مـــرن : يدعم Label و TextBox كعناصر عرض للوقت آمـــن : إذا تم حذف الوحدة النمطية يتحول تلقائياً إلى Fallback Mode باستخدام دالة الوقت الرئيسية : Now() خفيف : لا يعتمد على Timer إضافي للمراقبة جاهــز : يعمل مع النماذج الرئيسية و الفرعية أو الرئيسية المستقلة أو الرئيسية والفرعية معا ----------------------------------------------------- الوحدة النمطية العامة الاسم المقترح: basClockManager الكود... 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 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 ErrorHandler Dim vParentForm As Access.Form Dim vControlName As String Set vParentForm = frm.Parent vControlName = GetSubformControlName(vParentForm, frm) If Len(vControlName) > 0 Then MakeClockKey = vParentForm.Name & "|" & vControlName & "|" & frm.Name Exit Function End If ErrorHandler: MakeClockKey = frm.Name End Function Private Function CreateClockState(frm As Access.Form, _ ByVal pControlName As String, _ ByVal pIntervalMS As Long) As Object Dim vState As Object Set vState = CreateObject("Scripting.Dictionary") Dim vIsSubform As Boolean Dim vParentName As String Dim vSubCtlName As String On Error Resume Next vParentName = frm.Parent.Name vSubCtlName = GetSubformControlName(frm.Parent, frm) vIsSubform = (Len(vSubCtlName) > 0) On Error GoTo 0 vState.Add "Key", MakeClockKey(frm) vState.Add "HostFormName", frm.Name vState.Add "ParentFormName", vParentName vState.Add "SubformControlName", vSubCtlName vState.Add "IsSubform", vIsSubform vState.Add "ControlName", pControlName vState.Add "WasStoppedByVBE", False vState.Add "IntervalMS", pIntervalMS Set CreateClockState = vState End Function Public Sub StartSmartClock(frm As Access.Form, _ ByVal pControlName As String, _ Optional ByVal pIntervalMS As Long = 1000) On Error GoTo ErrorHandler EnsureClockStore Dim vKey As String Dim vState As Object vKey = MakeClockKey(frm) If gClocks.Exists(vKey) Then gClocks.Remove vKey Set vState = CreateClockState(frm, pControlName, pIntervalMS) gClocks.Add vKey, vState frm.TimerInterval = pIntervalMS If gAccessHwnd = 0 Then gAccessHwnd = Application.hWndAccessApp If gHook = 0 Then gHook = SetWinEventHook( _ EVENT_SYSTEM_FOREGROUND, _ EVENT_SYSTEM_FOREGROUND, _ 0, _ AddressOf ForegroundChangedProc, _ 0, 0, _ WINEVENT_OUTOFCONTEXT) End If Exit Sub ErrorHandler: End Sub Public Sub StopSmartClock(frm As Access.Form) On Error Resume Next EnsureClockStore Dim vKey As String vKey = MakeClockKey(frm) frm.TimerInterval = 0 If gClocks.Exists(vKey) Then gClocks.Remove vKey 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 vKey As String Dim vState As Object vKey = MakeClockKey(frm) If Not gClocks.Exists(vKey) Then Exit Sub Set vState = gClocks(vKey) If IsVbeOpen() Then vState("WasStoppedByVBE") = True frm.TimerInterval = 0 Exit Sub End If Dim vTimeText As String vTimeText = Format$(Now(), "dd/mm/yyyy hh:nn:ss AM/PM") If Len(vState("ControlName")) > 0 Then UpdateControlDisplay frm, vState("ControlName"), vTimeText 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 Private Sub UpdateControlDisplay(frm As Access.Form, ByVal pControlName As String, ByVal pDisplayText As String) On Error Resume Next Dim vControl As Access.Control Set vControl = frm.Controls(pControlName) If vControl Is Nothing Then Exit Sub Select Case vControl.ControlType Case acTextBox If vControl.Value <> pDisplayText Then vControl.Value = pDisplayText End If Case acLabel If vControl.Caption <> pDisplayText Then vControl.Caption = pDisplayText End If End Select End Sub Private Function GetSubformControlName(vParentForm As Access.Form, vChildForm As Access.Form) As String On Error Resume Next Dim vControl As Access.Control For Each vControl In vParentForm.Controls If vControl.ControlType = acSubform Then If vControl.Form Is vChildForm Then GetSubformControlName = vControl.Name Exit Function End If End If Next vControl End Function Private Function GetStateTargetForm(vState As Object, ByRef vForm As Access.Form) As Boolean On Error GoTo ErrorHandler If vState("IsSubform") Then If (SysCmd(acSysCmdGetObjectState, acForm, vState("ParentFormName")) And acObjStateOpen) = 0 Then Exit Function Set vForm = Forms(vState("ParentFormName")).Controls(vState("SubformControlName")).Form Else If (SysCmd(acSysCmdGetObjectState, acForm, vState("HostFormName")) And acObjStateOpen) = 0 Then Exit Function Set vForm = Forms(vState("HostFormName")) End If GetStateTargetForm = Not (vForm Is Nothing) Exit Function ErrorHandler: Set vForm = 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 vKey As Variant Dim vState As Object Dim vForm As Access.Form For Each vKey In gClocks.Keys Set vState = gClocks(vKey) If vState("WasStoppedByVBE") Then If GetStateTargetForm(vState, vForm) Then vForm.TimerInterval = vState("IntervalMS") Dim vTimeText As String vTimeText = Format$(Now(), "dd/mm/yyyy hh:nn:ss AM/PM") If Len(vState("ControlName")) > 0 Then UpdateControlDisplay vForm, vState("ControlName"), vTimeText End If vState("WasStoppedByVBE") = False End If End If Next vKey End Sub ----------------------------------------------------- طريقة الاستدعاء في النماذج نموذج يعرض الوقت في Label الكود... Private Sub Form_Load() Application.Run "StartSmartClock", Me, "lblTime", 1000 End Sub Private Sub Form_Timer() Application.Run "SmartClockTimer", Me End Sub Private Sub Form_Unload(Cancel As Integer) Application.Run "StopSmartClock", Me End Sub ----------------------------------------------------- نموذج يعرض الوقت في TextBox الكود... Private Sub Form_Load() Application.Run "StartSmartClock", Me, "txtTime", 1000 End Sub Private Sub Form_Timer() Application.Run "SmartClockTimer", Me End Sub Private Sub Form_Unload(Cancel As Integer) Application.Run "StopSmartClock", Me End Sub ----------------------------------------------------- نموذج بدون عرض نصي للوقت الكود... Private Sub Form_Load() Application.Run "StartSmartClock", Me, "", 1000 End Sub Private Sub Form_Timer() Application.Run "SmartClockTimer", Me End Sub Private Sub Form_Unload(Cancel As Integer) Application.Run "StopSmartClock", Me End Sub ----------------------------------------------------- كما تلاحظون الاستدعاء سهل وموحد سواء أردنا عرض الوقت في TextBox أو Label Application.Run "StartSmartClock", Me, "", 1000 ملاحظة هامة حول معامل : TimerInterval وهو المعامل الثالث فى الاستدعاء (Interval) الرقم: 1000 هو قيمة TimerInterval يمثل الفاصل الزمني بالميلي ثانية القيمة الافتراضية : 1000 (ثانية واحدة) تم ضبطها مسبقاً داخل الوحدة النمطية هل هو إجباري؟ لايمكن حذفه والاعتماد على القيمة الافتراضية طرق الاستدعاء المختلفة مع المعامل : ' الطريقة الأولى: تمرير قيمة مخصصة (مثلاً نصف ثانية) Application.Run "StartSmartClock", Me, "lblTime", 500 ' الطريقة الثانية: حذف المعامل (يتم استخدام 1000 تلقائياً) Application.Run "StartSmartClock", Me, "lblTime" في بعض الحالات قد يرغب المصمم في عمل التالى : ساعة عادية لذلك سوف تكون قيمة : TimerInterval =1000 (ثانية واحدة) ساعة دقيقة (Stopwatch) تكون قيمة TimerInterval = 100 (جزء من الثانية) ساعة بطيئة (تحديث نادر) تكون قيمة TimerInterval = 5000 (5 ثوانٍ) لهذا السبب تم جعل هذا المعامل اختيارياً مع استخدام القيمة الإفتراضية المنطقية مع إتاحة المجال للمصمم لتغييره حسب احتياجاته ----------------------------------------------------- نموذج مع Fallback ( منتهى الأمان ) الكود... Option Compare Database Option Explicit Private mIsSmartClockActive As Boolean Private Sub Form_Load() AttemptStartSmartClock End Sub Private Sub Form_Timer() Dim vTimeText As String vTimeText = Format$(Now(), "dd/mm/yyyy hh:nn:ss AM/PM") If mIsSmartClockActive Then Application.Run "SmartClockTimer", Me Me.txtDClock = vTimeText Else ' Fallback: النموذج يحدث نفسه بنفسه Me.txtDClock = vTimeText Me.lblDClock.Caption = vTimeText End If End Sub Private Sub Form_Unload(Cancel As Integer) On Error Resume Next If mIsSmartClockActive Then Application.Run "StopSmartClock", Me End If Me.TimerInterval = 0 On Error GoTo 0 End Sub Private Sub AttemptStartSmartClock() On Error GoTo FallbackMode Application.Run "StartSmartClock", Me, "lblDClock", 1000 mIsSmartClockActive = True Exit Sub FallbackMode: Err.Clear mIsSmartClockActive = False Me.TimerInterval = 1000 End Sub ----------------------------------------------------- الخلاصة النهائية :الاستدعاء المناسب عرض الوقت في : Label LabelStartSmartClock Me, "lblTime" عرض الوقت في : TextBox StartSmartClock Me, "txtTime" بدون عرض نصى للوقت مثلا : ساعة عقارب (بدون عرض نصي) StartSmartClock Me, "" نموذج فرعي (Subform) نفس الكود - يتم اكتشافه تلقائياً نماذج متعددة في نفس الوقت مدعوم بالكامل ملاحظات مهمة إعدادات الأمان : يجب تفعيل Trust access to the VBA project object model في إعدادات Trust Center إصدار Access : يعمل مع Access 2007 والإصدارات الأحدث مراجع إضافية : لا يحتاج إلى إضافة أي مراجع Fallback Mode : إذا تم حذف الوحدة النمطية، يتحول النموذج تلقائياً إلى استخدام Now() مع هذا الحل الفريد أصبح : التحكم في TimerInterval أثناء فتح محرر VBA أمراً تلقائياً بالكامل، دون أي تدخل يدوي أو تعقيدات سهولة فتح محرر VBA و إضافة أو تعديل أى أكواد في نفس وقت عرض النماذج وبدون أن تحدث المشكلة الكلاسيكية بسبب : TimerInterval استمتع بتجربة تطوير سلسة وخالية من المشاكل
  4. الاخ الكريم MOOSAK اشكرك على المتابعة و الاهتمام بالرد الشافى و لكن ردا على استفسارك بخصوص شكلة عندى هو دى و بيتم تحميله فى جميع الاوقات و خيارات المعالجة غير مفعله عموما كل المقصود هو تقديم كل التقدير و الاحترام لشخصك فقط اشكرك
  5. Today
  6. تفضل اسناذ @بلال بلال المرفق بعد التعديل بطلبك .حسب مافهمت .ووافني بالرد . 19840019_ Plateform-1.rar
  7. أخي الكريم سبب المشكلة بالتفصيل: تفعيل خيار "عرض الصيغ" (Show Formulas): ورقة العمل تحتوي على إعداد داخلي (showFormulas="1") يقوم بإظهار القيم الرقمية الخام للتواريخ (مثل 41604) بدلاً من التاريخ المنسق (2013/11/26)، مهما حاولت تغيير التنسيق. تجميد الصفوف: وجود صفوف مجمدة (حتى الصف 😎 قد يجعل التنقل وتغيير الإعدادات لبعض الأعمدة يبدو وكأنه لا يستجيب بشكل طبيعي. التنسيق المخصص: العمود G يستخدم تنسيقاً مخصصاً (yyyy/mm/dd) وهو صحيح، لكنه لا يظهر بسبب النقطة الأولى. كيفية حل المشكلة في ملفك الأصلي: يمكنك حل المشكلة بضغطة زر واحدة : اذهب إلى تبويب صيغ (Formulas) في شريط الأدوات العلوي. في مجموعة تدقيق الصيغ (Formula Auditing)، ستجد خيار إظهار الصيغ (Show Formulas) مفعلاً، قم بالضغط عليه لإلغاء تفعيله. أو استخدم اختصار لوحة المفاتيح: Ctrl + ~ )مفتاح حرف الذال في الكيبورد العربي(. بمجرد إلغاء هذا الخيار، ستظهر جميع التواريخ في العمود G بتنسيقها الصحيح فوراً. سبب نجاح الحل عند النسخ لملف جديد هو أن هذا الإعداد خاص بورقة العمل الحالية ولا ينتقل عند نسخ البيانات فقط إلى ملف جديد. الصورة المرفقة من عندي أوفيس 365
  8. السلام عليكم لدي ورقة اسمها حجز التوقيت اريد اضافة ترحيل الحقول بالون الاحمر الى ورقة اسمها Feuil1 الحقول عند الترحيل لم يتم افراغها لدي ورقة اسمها Plateform اريد اضافة ترحيل الحقول بالون الاحمر الى ورقة اسمها Feuil2 الحقول عند الترحيل لم يتم افراغ الحقول بالون الأحمر فقط اما الحقول بالون الأصفر عند الترحيل يتم افراغ الحقول لدي اوفيس 2010 عند فتح الاكسيل في اوفيس 2007 لم أسطيع هل توجد طريقة كلمة المرور 19840019 واسم المستخدم 19840019 بارك الله فيكم Plateform19840019.xlsb
  9. السلام عليكم اريد اضافة للبرنامج لتسجيل الدخول أن يظهر شريط بالون الازرق و أمه رسالة مكتوبة الرجاء الانتظار عند الضغط على تسجيل الدخول االيكم البرنامج فيه الشرح 19840019_ Plateform.zip
  10. عند فتح الشيت اضغظ مباشرة على الزرين في نفس الوقت ولا تحدد اي خلايا او استخدم الكود بالملف 5000_A3.xlsb
  11. أخي الكريم .. الملف مفتوح المصدر .. لا اعلم ما طبيعة المشكلة لأن المشروع مفتوح وليس هناك قيود تمنع التشغيل إلا إذا نقلت المشروع الى قاعدة أخرى وكان هناك مشكلة في المكتبات ..
  12. بارك الله فيك اخي الكريم الملف هذا جزء فقط من ملف جد ضخم لم اتمكن من رفعه وقمت بحذف عدة اعمدة منه ربما لم اقم بصياغة سؤالي جيدا اود معرفة الطريقة ...لتطبيقها على الملف الكلي مرحبا اخي عبد الله قمت بالامر لكن لم يتغير شي... كيف اطبق هذا ..احدد الخلايا واضغط على الزرين ؟
  13. وعليكم السلام ورحمة الله وبركاته اضغط على مفتاحي Ctrl + ~ (المفتاح الذي فوق Tab)
  14. وعليكم السلام ورحمة الله وبركاته تفضل الملف بعد التعديل 5000_A3_(2).xlsx
  15. اهلا اخي الكريم انا فعلا عندي الاعدادات باللغة العربية
  16. اولا أشكرك جدا أستاذي الفاضل لكن برسل لك أكسيل شيت فيه كافة البيانات اللي محتاجها إن أمكن يكون التصميم لنفس البيانات الرئيسية وأنا بعد ذلك أدخل البيانات الله يسعدك لكن كرما يكون فيه نموذج لتقرير شامل مثل هذا اللي بالاكسيل وجزاكم الله خير الجزاء قاعدة بيانات الشركة.xlsx
  17. =IF(MOD(N9,5)>0,INT(N9/5)+1,INT(N9/5)) ...... في الخلية m10 =IF(MOD(N9,5)>1,INT(N9/5)+1,INT(N9/5)) ...... في الخلية m11 =IF(MOD(N9,5)>2,INT(N9/5)+1,INT(N9/5)) ...... في الخلية m12 =IF(MOD(N9,5)>3,INT(N9/5)+1,INT(N9/5)) ...... في الخلية m13 =IF(MOD(N9,5)>4,INT(N9/5)+1,INT(N9/5)) ...... في الخلية m14 الشروط للتوزيع: عندما يكون منتدب في الجدول يتم التوزيع على الايام الحضور فلو 3 حصص ويحضر يومان يكون التوزيع 2 و 1 اما لو كان يخضر يوميا يكون 1 و 1 1 لكل يوم واذا كان 6 حصص يكون يون 2 وباقي الايام 1 خصة
  18. الشكر موصول لك أخي @AMINYOUSIF على المتابعة 🙂 بالنسبة لسؤالك الأول فهي تعمل كما كانت سابقا .. هل تظهر عندك بشكل مختلف ؟ بالنسبة لهذه الرسالة فهي للأسف بسبب محدوديات الخدمات المجانية المقدمة من قبل شركة جوجل أو بسبب الضغط على السيرفر في تلك الأثناء .. جوجل تبغى تطلع عينك علشان تشترك ويحسنوا لك الخدمة 😅🖐 وحلها إما أنك تحاول مجدد بعد دقيقة أو تجي في وقت لاحق وتحاول مجددا .
  19. كلام يجعلني أعجز عن الرد 😅 قبل فترة كنت قد شاركت في أحد مواضيع المنتدى بمثال لساعتين تعمل بدون إستخدام حدث Timer ولكنهما لم يعالجان هذه المشكلة حاولت البحث عن الموضوع ولم أستطيع الوصول إليه ولكني أحتفظ بنسخة من الملف وسأرفقه هنا وبعد وضع لمساتك الساحرة عليه أعتقد أنه سيكون مثال جميل لإستخدام الساعة كنموذج فرعي أو نموذج مستقل AnalogClockWithoutTimer.rar
  20. الف شكر على ثنائك الطيب وحسن خلقك وهو امر ليس مستغرب ويعلمه كل من عرفكم حق المعرفة اخي محمد ان ما نعتني به ليس الا قليل مما لديكم الشايب
  21. السلام عليكم من فضلكم اجد مشكل في اظهار التاريخ ..جربت كل الطرق ولم اجد حل عند الضغط على الخلية يظهر التاريخ في الشريط فقط عند اضافة شيت يظهر التاريخ بشكل عادي لكن في هذا الشيت لايظهر 5000_A3.xlsx
  22. السلام عليكم الرجاء مساعدتي في تصميم UserForm برمجة اكسل.xlsm
  23. هههههه ، والله إنك لأخطأت بي الظن هنا .. على العكس تماااااااماً أنا لين وكما تريد ، بل وأكثر .. دعني أكون مستفيداً أكبر حظاً من هذا النقاش الممتع معكم أولاً . ومن ثم أتعلم منكم ثانياً وأستفيض من خبرتكم . لا تقلق . لها حل بإذن الله تعالى
  24. يا هلا والله استاذى الجليل و معلمى القدير , استاذ @شايب حياكم الله وبياكم أستاذي الأجلّ، ومعلمي الأكرم، أطال الله بقاءكم على الخير، وأدام عليكم نعمة الفضل، وجعل العلم حيث كنتم أنيسَ مجلسٍ، وزينةَ قولٍ، وبركةَ أثرٍ. لقد وقفتُ على تعليقكم وقوفَ التلميذ بين يدي أستاذه، لا وقوفَ المتلقّي لثناءٍ يُطربه، بل وقوفَ المستفيد من ملاحظةٍ تهديه، وكلمةٍ تقومُ اعوجاج العبارة، وتردّها إلى سواء السبيل. وما كان لكلماتكم أن تقع في النفس إلا موقع القَبول، وهي صادرةٌ عن ذائقةٍ مرهفة، ودُربةٍ طويلة، وخبرةٍ عرفت للشعر موازينه، وللبيان مواضع إحسانه وإساءته. وإنّي، والله، لأرى تعقيبكم عليَّ من تمام النعمة، لا من باب المجاملة العابرة، لأن الثناء قد يسرّ صاحبه ساعةً، أمّا التوجيه الصادق فيبقى له في النفس أثرٌ، وفي الصنعة نفعٌ، وفي الطريق نورٌ يُهتدى به. وما تعلّمنا من أساتذتنا الأفاضل أن الكلمة تُترك على عِلاتها، ولا أن النص يُمرَّر على هناته، بل عهدناهم يرفقون في التنبيه، ويعدلون في الحكم، ويجمعون بين أدب النصيحة ونُبل المقصد؛ وذلك، بعينه، ما لمستُه في تعليقكم الكريم. ولقد أحسنتم، يا أستاذي، إذ جعلتم ملاحظتكم في موضعها، وأودعتموها من رفيق العبارة، ولطيف الإشارة، ما يفتح باب الفائدة من غير مشقّة، ويقيم الحجة من غير كلفة، ويُشعر المتلقي أنه بإزاء قلبٍ ناصح، لا لسانٍ متعقب. وتلك سجية الكبار من أهل العلم والأدب؛ إذا لاحظوا لم يجرحوا، وإذا قوّموا لم يفضحوا، وإذا علّموا بثّوا مع العلم مروءةً، ومع البيان رحمةً، ومع النقد إنصافًا. أما أنا، فما كنتُ يومًا أزعم لنفسي عصمةً من زلل، ولا سلامةً من نقص، وإنما هي محاولاتُ محبٍّ للقول، يمضي على هدى ما وعى، ثم لا يجد أكرم من عين أستاذه تُبصر له ما خفي، وتوقظه على ما فاته، وتدلّه على ما هو أولى وأقوم. فإن كان في النص شيءٌ استحسن، فذاك ـ بعد فضل الله ـ ثمرةُ ما تلقيناه من أمثالكم، وإن كان فيه خللٌ أو قصور، فحسبُ المرء شرفًا أن يجد من يرده برفقٍ إلى الصواب، ويأخذ بيده إلى الأحسن والأتمّ. وقد زاد تعقيبكم الكريم عودتي بهجةً، لأن عودة المرء لا تُحمد إلا إذا استقبلها أهل الفضل بقبولٍ جميل، ورعايةٍ صادقة، ونظرٍ منصف. والحمد لله الذي جعل في الطريق وجوهًا إذا حضرت اطمأنّ القلب، وإذا تكلّمت أشرقت العبارة، وإذا نبّهت كان في تنبيهها أدبُ المعلّم، ووفاءُ المحب، وهيبةُ العالم. فلكم مني، يا سيدي، أخلصُ الشكر، وأوفى الامتنان، وأصدقُ الدعاء؛ فلقد كنتم ـ كما عهدناكم ـ أستاذًا لا يقف عطاؤه عند حد التعليم، بل يتجاوزه إلى التهذيب والتقويم والإحسان. أسأل الله أن يبارك في عمركم وعلمكم، وأن يديم في الأدب ظلّكم، وأن يكتب لكم أجر ما تبثّونه من نورٍ في القلوب والعقول. وما أنا إلا تلميذٌ يعرف لأستاذه حقّه، ويوقن أن بعض الفضل مهما قيل فيه لا تحيط به العبارة، ولا توفيه الألفاظ.
  25. هذا الجزء يتعلق بمايكروسوفت نفسها . حيث أنها تسمح لك باستيراد الجداول والإستعلامات من أي ملف ACCDE مقفل .. يعني هم نفسهم تركوها مفتوحة لقولهم أن البيانات حق من حقوق المستخدم ، أما التصاميم والنماذج فيتم اقفالها بتشفيرهم الخاص بهم . هذا تأكيد صريح بأن الفكرة موجودة من قبل اقتراحي للأداة لما طرحته من تجربة بإنه يمكن استخلاص المشروع كاملاً ما لم يحتوي على أكواد VBA . هذه ميزة قد أضيفها للأداة .. فلم لا !! حينها اكون أول من يضيف حماية لأصحاب المشاريع من كسر قواعد البيانات Accde الخاصة بهم . وهذا ما لم يوفره غيري على مستوى العالم . كل الشكر والتقدير لكم أستاذنا الكبير .. متعلمين من خبرتكم ما لم نكن نعلم . والفضل لله الذي علمنا ما لم نعلم .
  1. أظهر المزيد
×
×
  • اضف...

Important Information