Foksh

أخي بلانك ..

  لإجراءاتكم بنقل الإجابة إلى الحل الأخير . ما لم يكن هناك أي تعديل آخر .

3 ساعات مضت, jjafferr said:

تفضل ، ارفقت المثال البسيط ، فرجاء تضبيطه بدالتك 🙂

أراك قد عدت الى استعمال الساعة في برامجك أخي جعفر .. رغم مقولتك :-

18 ساعات مضت, jjafferr said:

انا لا استعمل الساعة في اي من برامجي ،

وهنا أراك تبحث عن ثغرة برأس الإبرة .😉.

علك قد تجد حلاً في يوم من الأيام .. لأن الفكرة التي نفذناها نفذت خصيصاً لكي تغنيك عن طريقة =Now() وفكرة التايمر الميتة التي طرحتها وتشتكي منها أصلاً !

بالتوفيق 😇

مبارك عليك الحل .. وعذراً لعدم المتابعة معك في وقتها ، بس كنت خارج من الشغل للأسف ..

58 دقائق مضت, أحمد العيسى said:

تمام لكلا الملفين ، وأعتقد أنه لا حاجة لتحويل هذا المرفق إلى نظام 2003   لأن المطلوب هو تأثيره على ملفات 2003  بجانب تأثيره على الملفات الأحدث

في المرفق اللي رفعتهولك ، كان فعلاً يتم التنفيذ على الإمتدادين MDB و ACCDB من إصدارات 2007 وما فوق .. لكنك بحثت عن فكرة زرين لكل وظيفة ، وهذا كان يسيراً جداً من خلال الفكرة اللي طرحتها .. ولكن كل الطرق تؤدي إلى روما - ما دامت روما قريبة -  ..

وفعلاً نسختك اللي رفعتها ما اشتغلتش عندي أنا كمان وده اللي خلاني أطلع وقلت بجرب على كمبيوتر تاني .. 👍🏻

11 دقائق مضت, أحمد العيسى said:

إذا تم التأشير واختيار عناصر الاختيار لا يتم تغير المسمى على زر تفعيل مفتاح الشيفت طبقاً للإختيار  والمطلوب التعديل هنا

أصغر همومك أخي أحمد .. كمثال ؛ في حدث بعد التحديث للعنصر OptMain ، جرب الفكرة التالية أو كما تريد لحاجتك :-

Private Sub OptMain_AfterUpdate()
    If Me.OptMain.Value = 1 Then
        Me.Btn_Doit.Caption = "إلغاء تفعيل مفتاح الشيفت"
    Else
        Me.Btn_Doit.Caption = "تفعيل مفتاح الشيفت"
    End If
End Sub

منذ ساعه, jjafferr said:

وخلال عمل ذلك النموذج ، اريد ان اعدل الكود في نموذج آخر ، بحيث اشتغل فيه كالمعتاد ولا يسبب لي مشكلة في كتابة الكود.

اهاااا .. فهمتك الحين ..

يعني كتشبيه بسيط !!

كالميكانيكي الذي يريد إصلاح ماتور سيارة أثناء سيرها  ..

بلهجتنا الأردنية = كيف .. ليش .. وين .. متى ؟؟ هو حر يدبر راسه ، و يفك الماتور ويصلحه والسيارة شغالة  .

وبما أنك مصر على الوقوف عند عقدة آكسيس ، لم لا تنقل حدثك من عند الوقت الى دالتي المتواضعة ( NativeTimerCallback ) 😎 !!

وبما أن كود مراقبة المجلدات لا يعتمد على التعديل الرسومي للواجهة ، فإنه سيستمر بالعمل أخي جعفر ، بل ومراقبة المجلدات كل ثانية في الخلفية ، حتى وأنت داخل محرر الأكواد ، تستطيع تكتب أكوادك بكل هدوء وسلام 😏 ..

مجهود جميل أستاذ @عبدالله بشير عبدالله ، ومتابعة جيدة جداً منكم جميعاً ..

تم نقل الإجابة إلى آخر مرفق . وعله يكون الشافي لأخينا @بلانك  

3 ساعات مضت, jjafferr said:

اضطر للتعامل مع Timer Interval في بعض النماذج لفحص مجلدات معينة (هناك مجلد مشاركة بين المستخدمين ، والبرنامج يراقب هذا المجلد ، فلما يجد فيه ملف معين ، يقوم بعمل معين) ، هذا النوع من المجلدات يسمى Hot Folder.

وعليكم السلام ورحمة الله وبركاته ..

أهلاً بك معلمي الفاضل @jjafferr ، وأشكرك جداً على هذه الملاحظة الدقيقة والمهنية . نقطتك في محلها تماااااماً ؛ فالتحديث الأول أوقف التايمر الخاص به فقط ولكنه لم يتدخل في تايمرات النماذج التقليدية ( Timer Interval ) كاستخدامك لها في الـ ( Hot Folders ) ، مما استمر في مقاطعتك كمطور عند كتابتك للأكواد داخل المحرر .

ولذلك ، ولحل هذه المعضلة بشكل جذري وجعل الفكرة ناجحة 100% ، قمت بتوسيع مهام حدث الويندوز ForegroundChangedProc .

الفكرة الآن أنه وبمجرد مرور تركيز الويندوز إلى نافذة محرر الأكواد VBA ، سيقوم الكود بمسح جميع النماذج المفتوحة بلحظة واحدةً ، وبالتالي يحفظ قيم التايمر لها - عند وجود الحدث فقط - في ذاكرة مؤقتة ، ويجعل التايمر = 0 . وعند إغلاقك المحرر ، سيعيد الاستئناف بدقة لكل نموذج بناءً على ما تم حفظه في الذاكرة .

وقد تم الاعتماد على خصيصة hWnd كمعرف فريد للنماذج بدلاً من اسمها تفادياً لأي خطأ ( في حال كنت تستدعي أكثر من نسخة لنفس الحدث ) 😅 .

• سنقوم بالإعلان عن متغير ( الذاكرة المؤقتة ) الذي ستعيش وتموت مع فتح وإغلاق محرر الأكواد VBA ، كالآتي :-

Private colPausedForms As Collection

• الإضافة الثانية ( عملية الإيقاف والفكشنة عند فتح VBA ) . وتكون في الجزء الأول من دالة ForegroundChangedProc داخل شرط If IsVBEOpen() Then ، وهي المسؤولة عن حصر النماذج المفتوحة لدالة الصيد لتقوم بإيقافها وتتبع النماذج الفرعية داخلها :-

            Set colPausedForms = New Collection
            Dim frmMain As Object
            For Each frmMain In Forms
                PauseAllTimers frmMain
            Next frmMain

• الإضافة الثالثة ، وتكون في الجزء الثاني Else عند إغلاق الـمحرر ، وهي المسؤولة عن إعادة الروح للتايمرات وقيمها الأصلية كما كانت عليه :-

                    If Not colPausedForms Is Nothing Then
                        Dim frmMain2 As Object
                        For Each frmMain2 In Forms
                            ResumeAllTimers frmMain2
                        Next frmMain2
                        Set colPausedForms = Nothing
                    End If

• أما الإضافة الرابعة والأخيرة 😅 ( دالتين صغيرتين بمثابة محركات البحث المتداخل ) ، لكتابة وحفظ البصمات 😁 :-

Private Sub PauseAllTimers(frm As Object)
    If frm.TimerInterval > 0 Then
        On Error Resume Next
        colPausedForms.Add frm.TimerInterval, CStr(frm.Hwnd)
        frm.TimerInterval = 0
        On Error GoTo 0
    End If
    
    Dim ctl As Object
    On Error Resume Next
    For Each ctl In frm.Controls
        If ctl.ControlType = 112 Then 
            If Not ctl.Form Is Nothing Then PauseAllTimers ctl.Form
        End If
    Next ctl
    On Error GoTo 0
End Sub

Private Sub ResumeAllTimers(frm As Object)
    On Error Resume Next
    Dim savedInterval As Long: savedInterval = 0
    savedInterval = colPausedForms(CStr(frm.Hwnd))
    If savedInterval > 0 Then frm.TimerInterval = savedInterval
    
    Dim ctl As Object
    For Each ctl In frm.Controls
        If ctl.ControlType = 112 Then
            If Not ctl.Form Is Nothing Then ResumeAllTimers ctl.Form
        End If
    Next ctl
    On Error GoTo 0
End Sub

الآن الكود بحلته الجديدة وملفه الجديد تالياً ( فضلاً لا أمراً ، افتح النموذج Frm_WithTimerInterval ) وضع به ما شئت من نماذج فرعية بداخل بعضها البعض ذات تايمرات مستمرة ! ثم جرب الدخول إلى المحرر

Time With No TimerInterval.accdb

37 دقائق مضت, أحمد العيسى said:

عند التشغيل على أكسس 2003 يقوم باللازم نحو اللاحقة  mdb

ليس لدي نسخة 2003 حتى أقوم بالتجربة ، ولكن الأمر مرهون بتجربتك على أكثر من إصدار أخي الكريم ..

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

28 دقائق مضت, محب العقيدة said:

مشكله الاكسس يختلف عن البقية

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

https://github.com/tyler-73/MS-Access-mcp

يدعي صاحبها ان هناك تحكم كامل بكل الاكسس عن طريق الذكاء الاصطناعي طبعا انا لم اجرب هذا المشروع

انا انشئت ما ام سي بي سيرفر  فب الجيت هب واحاول الان ان اجد حل للهلوسة  التي تحدث للذكاء الاصطناعي عن طريق الام سي بي سيرفر طبعا الان انا استخدم skill.me

طبعا لم تقضي على الهلوسه بشكل كامل كان الحل النهائي استخدام الام سي بي سيرفر للاتصال بقاعده البيانات واضافه وحذف ....... اما التنفيذ الحرفي للاضافة والحذف.....عن طريق سكربت البايثون والتعليمات العامه عن طريق ملف skill.md

طبعا لماذا ملف الام سي بي سيرفر لا يحتوي على التعليمات بشكل حرفي لانه الام سي بي سيرفر يجب ان يتعامل مع كل قواعد البيانات اما ملف البايثون فهو يستخدم وينشأ لكل قاعده بيانات على حدا اما ملف الاسكيل الام الدي خوفا من الهلوسه

في الحقيقة هذا الكلام كبيراً على عقلي الصغير فعلياً ، وليس لي تجربة حقيقية بهذا المجال ( الـ MCP ) .. ولكن من خلال فيديوهاتك التي ارفقتها في أحد المواضيع ، توضحت جزئياً الفكرة والهدف المرجو من الـ MCP ..

من تجارب صديق لي في استخدام الذكاء الصناعي بإنشاء مشاريع بايثون ، فأكد لي فعلياً انه مجرد جعل الذكاء يفهم المطلوب حتى يقوم بإنشاء مشروع جاهز بصيغته Py على ما اذكر .. لكن لم تمر علي تجربة لإنشاء Accdb جاهز وكامل متكامل من خلال الذكاء الصناعي ..

هذا والله أعلم ..

هذه الثمرة التي تحصل عليها عندما يكون المطلوب واضحاً من بدايته ..

جزاكم الله خيراً جميعاً أساتذتنا اللذين ساهموا في حل المشكلة لأخونا @بلانك ... 

40 دقائق مضت, ابو جودي said:

فوق ده كله الاعتماد على On Error Resume Next معناه تجاهل الأخطاء بدل حلها وكأن المشكلة ستختفي بمجرد إخفائها وهذا ليس حلا بل تأجيل للأزمة فقط

فعلاً ده كان رد الذكاء الصناعي لما سألته عن الكود 

خلاف ذلك ، ليس محل نقاش . فيما رأيته :-

41 دقائق مضت, ابو جودي said:

فكرة إن الساعة تشتغل حتى في وضع التصميم

شكراً لتفاعلك  😎

بناءً على طلبك أخي @أحمد العيسى ، هذه مشاركة بسيطة ، جربها رجاءً على أوفيس 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

21 دقائق مضت, محب العقيدة said:

طيب لو اخترت ملفك الذي سترفعه لاحصل على الكود المصدري🤔

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

22 دقائق مضت, محب العقيدة said:

او انك ستقدم خدمة سحابية😍

لا تستغرب ، قد يكون هذا أحد السيناروهات اللي ممكن أسلكها في طريقة عملي ..

23 دقائق مضت, محب العقيدة said:

ولكن في نفس الوقت متشكك لغايه الان من استرداد الكود المصدري كامل حتى لو اكد الاخ فاد مع احترام الشديد له انه يستطيع ذلك؟

وقت الجد سأجعلك تجرب بنفسك على أي نسخة من أي مشروع تريده ( لأني لم أستثني أي بصمة وأي مشروع لغاية الآن ) .. لذلك لا تضيع فرصتك الثمينة على ملفي ..

ودائماً وأبداً ، يسعدني مروركم العطر هذا 

[تعليق جعفر] بالاشارة الى الموضوع التالي

بعد فصل الموضوع عن رده في موضوعه المشار إليه أعلاه ..

بصوا على الخفة في الأداء😎 :-

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

ودي صورة كمان تخليك تستغرب إن الوقت والساعة شغالين في وضع التصميم لو عاوز .. يعني الحدث عند الوقت ملهوش أي اعتبار عندي هنا .

وما تحللش كتير في الكود يا أبو جودي ، هو بسيط و واضح ومقروء ، أصلي ما قرأتش في موضوعك غير جملتين  .

..

...

تخيلوا كمية الثقة اللي نبتت في نفسي بعد هذه الردود جميعها بحلوها ومرها ، بدعمها أو بانتقادها .. 

جعلتني أستمر في التطوير لحد ما أوصل للمخطط اللي راسي اليابس مخطط له اتجاه الـ Accde/Mde .. ومحاولة تسخير آكسيس وترويضه كما أريد تماااااماً ..

بحيث إني - أنا العبد الفقير إلى الله - أرسمله خط وهو يمشي عليه  ...

فالمفاجئة ستكون لكل من سجلت الأداة حضوره في السيرفر ؛ تفعيل للتجربة على استخراج الأكواد لملف واحد فقط حتى لو فرمت الكمبيوتر وغيرت كل القطع  .

يعني جهازك وإيميلك اللي سجلت فيهم رح يعطوك تجربة استخراج الأكواد لملف واحد فقط لا غير .. وبكل ثقة 

46 دقائق مضت, أحمد الشحات85 said:

اهلا اخي الكريم انا فعلا عندي الاعدادات باللغة العربية 

أخي الكريم .. الملف مفتوح المصدر .. لا اعلم ما طبيعة المشكلة لأن المشروع مفتوح وليس هناك قيود تمنع التشغيل إلا إذا نقلت المشروع الى قاعدة أخرى وكان هناك مشكلة في المكتبات ..

الان, شايب said:

راسك يابس 

هههههه ، والله إنك لأخطأت بي الظن هنا .. على العكس تماااااااماً

أنا لين وكما تريد ، بل وأكثر ..

دعني أكون مستفيداً أكبر حظاً من هذا النقاش الممتع معكم أولاً . ومن ثم أتعلم منكم ثانياً وأستفيض من خبرتكم .

لا تقلق . لها حل بإذن الله تعالى 

3 دقائق مضت, شايب said:

قبل الاكواد هناك طريقة انشاء الجداول الاصلية والمؤقتة وهي الاساس في بناء قاعدة البيانات وهناك تصميم النماذج وما تحتويه من حقول ظاهرة ومحفية ونصميم التقارير  والاستعلامات يا استاذي كل كائن في قاعدة البيانات هو حق من حقوق المبرمج

هذا الجزء يتعلق بمايكروسوفت نفسها . حيث أنها تسمح لك باستيراد الجداول والإستعلامات من أي ملف ACCDE مقفل .. يعني هم نفسهم تركوها مفتوحة لقولهم أن البيانات حق من حقوق المستخدم ، أما التصاميم والنماذج فيتم اقفالها بتشفيرهم الخاص بهم .

5 دقائق مضت, شايب said:

في قاعدة البيانات اكسس يمكن كما تعلم عمل برنامج متكامل يؤدي الغرض المطلوب بدون استخدام اكواد vba

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

6 دقائق مضت, شايب said:

هل كل مبرمج يتواصل معكم اخي لحجب برامجه

هذه ميزة قد أضيفها للأداة .. فلم لا !!

حينها اكون أول من يضيف حماية لأصحاب المشاريع من كسر قواعد البيانات Accde الخاصة بهم . وهذا ما لم يوفره غيري على مستوى العالم .

كل الشكر والتقدير لكم أستاذنا الكبير .. متعلمين من خبرتكم ما لم نكن نعلم . والفضل لله الذي علمنا ما لم نعلم  .

اخي الفاضل @الاهلاوى 2007

السلام عليكم ورحمة الله وبركاته ..

اختيارك لـ تمت الإجابة ، معناه أنك قد وجدت الحل ، ولكن وبما أن طلبك ما زال قائماً ولم تحصل على الحل الكامل ؛ نرجو منك اختيار الزر تمت الإجابة فقط عند المشاركة التي حققت لك الحل .

ولذا ، تصويباً للخطأ الغير مقصود ، في حال ما زال طلبك لم يتكتمل بالحل ، قم بإلغاء اختيار الإجابة ، وامنحها عند اغلاق الموضوع . أو إن كان طلبك التالي مختلفاً عن الأول . فحينها فاتح موضوع جديد لطلبك الثاني ، وأكمل في سؤالك الثاني  .

في 14‏/4‏/2026 at 06:30, ابوخليل said:

وندوز 10 اوفيس 10  32 بت انجلش

أهلا معلمي الفاضل أبو خليل ، يبدو أنني لست محظوظاً معك مع الإصدار 32 .. قد يكون لك تجربة مستقلة في الإصدار 64 .. وهذا يسعدني .😊.

في 14‏/4‏/2026 at 07:01, AbuuAhmed said:

يبقى انتهاكا للحقوق وإن قام به الآخرون، وهو كذلك "انتهاكا" لقوانين الموقع، فكم من مواضيع قام المراقبون والمشرفون بإغلاقها وصد ناشريها، فلما تمارسونها؟!
ممكن الموقع يقدم خدمات (مثلا) كإزالة كلمة مرور فقط لمالك برنامج بعد التثبت من ملكيته له، أما أكثر من ذلك فلا أراه صائبا.

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

يعني ممكن نتفق على بصمة داخل مشاريعك ،بمجرد الكشف عن وجودها يتوقف عمل الأداة ولا تسمح للمستخدم باستخراج مشاريعك أخي أبو أحمد ....

ما تفعله أداتي سبق وأخبرتك بأنه متاح وببرامج كثيرة ومجانية أيضاً وليست مدفوعة  يا صديقي ... أذكرلك منها مثلاً برنامج ، HxD وكل الشعب العربي يستعمله سواءً بالحلال أو الحرام .

..

في 14‏/4‏/2026 at 08:16, ابوخليل said:

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

2- مصدر باب رزق له .. كثيرون يمرون بهذه المشكلة العصيبة  .. وهنا يكون هو المسؤول عن هذا الرزق وبابه الشرعي .

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

في 14‏/4‏/2026 at 09:51, محب العقيدة said:

لا تتخوف اخي ابو خليل
الحصول على الكود المصدري ليس كما  تظن
انا اظن اذا كان الجهاز قد انزل عليه ملفACCDE 
ولم يكن تخزين ACCDB عليه ثم خزن ك ACCDE
فاعتقد استحالة استرجاع الكود المصدري
نسة تاكدي 99.9%💪
والجواب عند اخي Foksh
اما الحالة الاخرى فغير متاكد😅

أخي محب العقيدة ،حياك الله مجدداً ، أنرت مواضيعي بمشاركاتك لعدم رؤيتك بيننا 🥰 . قد أخالفك الرأي في نقطة واحدة أنني لا أحتاج للحالة الثانية بأن يكون هناك نسخة Accdb على الجهاز ثم تم حفظها Accde . ولكن ثق تماماً أنه 99.9% التي تحدثت عليها هي الآن = 1% وعن ثقة بما أقول صدقني .. وانا بإنتظار تجربتك على VB  ..

في 14‏/4‏/2026 at 12:13, شايب said:

بداية مع تيقني بان مشاركة اخيا الشايب غير مرحبا بها من قبل البعض ولكن هذا الموضوع قد يؤثر على الحقوق الفكرية للاخرين

وعليكم السلام ورحمة الله وبركاته .. يقينك ليس في محله صدقني أستاذي الشايب . وأنت من القامات التي استشهد برأيها وأستنفع بعلمها إلى جانب كوكبة من المعلمين الأفاضل والأساتذة والموهوبين المحترمين ..

لن يختلف ردي حول الحقوق المشروعة لكل صاحب ملف = وأنا مؤيد ومتفق 1000% فيما يدور القلق من حوله . لذا لها حل إن شاء الله  .

في 14‏/4‏/2026 at 12:13, شايب said:

بالنسبة لمثل هذه البرامج اجد ان نشرها في العلن ضرره اكبر من نفعة

النشر في العلن أفضل من النشر في الخفاء .. أنا طرحت فكرة كما طرحت الشركات الكبرى خدماتها وبرامجها .. فما الضرر في هذا ، لا أعلم !!!!

في 14‏/4‏/2026 at 12:13, شايب said:

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

موضوع استنساخ القاعدة والحصول على نسخة مماثلة ثم عمل كراك .... إلخ ؛ هنا قد أخالفك الرأي قليلاً .. فآكسيس لن يسمح للمستخدم بأن يستورد أو يستخرج التقارير أو النماذج التي تحتوي أوامر VBA .. فمثلاً وهذه معلومة جديدة على البعض مفادها من تجربة شخصية ..

1. جرب انشاء قاعدة بيانات واجعل أوامرها في أزرار تجريبية مثلاً عبارة عن ماكرو لتنفذ بعض المهام مع استعلامات  ... إلخ
2. احفظ النسخة واقفلها جيداً بصيغة ACCDE .
3. باستخدام برنامج HxD المتوفر على الانترنت ، أستطيع أن أستخرج لك نسخة كاملة من مشروعك ، وتعمل من المشروع بصيغة ACCDB مفتوحة المصدر  .

يعني مشكلة البعض الحالية تتعلق بأكواد VBA ، وخوفهم من كشفها  .

في 14‏/4‏/2026 at 12:13, شايب said:

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

والله الموفق

الأخ الفاضل - أخوك الصغير - لو كان له أي نوايا مخفية ، لما طرح الفكرة علناً .. أما فكرة أن أحذف البرنامج ، فأعتقد أني هنا لي رأي مخالف معك - الأداة حالياً مجانية بفائدتها الـ 20% التي رأيتموها ( إن كنتم جربتموها طبعاً ) . وليست ذات الضرر الذي أثار هذه الضجة الكبيرة ..

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

9 ساعات مضت, بوعلام بلقاسم said:

السلام عليكم ورحمة الله وبركاته،

وعليكم السلام ورحمة الله وبركاته..

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

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

دمت بخير 😇 

3 ساعات مضت, AbuuAhmed said:

لأسف الشديد بسبب موضوعكم هذا اضطررت لحذف برامجي العلمية المنشورة على الإنترنت والتي كانت ينتفع بها.

حياك الله اخي أبو أحمد..

موضوعي هذا ليس طفرة جينية جديدة ، بل سبقه برامج كثيرة وبمميزات أكبر موجودة في الإنترنت.

في 11‏/4‏/2026 at 20:28, منتصر الانسي said:

رغم أني لا أنشط إلا في منتدى أكسس إلا أني اليوم قررت أن أرفق لكم ملف أكسل

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