تفعيل وإلغاء الشفت .. ثلاث تطبيقات ، يرجى دمجهم فى تطبيق واحد

[أحمد العيسى]

السلام عليكم

بالمرفقات ثلاث تطبيقات بسيطة ورائعة من عمل أبو جودي والأخت زهرة

منهم من يقتصر فلتره على إظهار  mdb  والآخر على   accdb

المفترض أن البرنامج الناتج يتوافق مع أوفيس 2003  بالإضافة للإصدارات التالية

بالطبع سوف نري مع الشمول البرمجي الناحية الجمالية بأفضل صورة وأنا واثق من هذا

شكراً  لجميع الزملاء مقدماً

وتهنئة لنا بعودة أبو جودي للمنتدى من جديد

تفعيل وإلغاء الشفت1.mdb تفعيل وإلغاء الشفت2.mdb تفعيل وإلغاء الشفت3.mdb

[ابو جودي]

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

لكن على كل حال اليك المرفق بعد عمل اعادة هيكلة شاملة للكود كاملا 

 

تفعيل وإلغاء الشفت.mdb

[أحمد العيسى]

معذرة

يبدو أن الهيكلة تحتاج مراجعة لتحقيق الهدف النهائي

فى الفلترة : يكفى السطر الثالث ( كل الملفات )

أيضاً

هل من الممكن بعد اختيار ملف أكسس :اكتشاف الفاعلية تلقائياً (تمكين ، نعطيل )

وبذلك يكون زر واحد فقط هو من يتم اختياره

بالنسبة لملف   *.accdb   لم ينجح التطبيق فى تغيير الخاصية

[Foksh]

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

تم تعديل منذ 2 ساعات بواسطه Foksh
إضافة آخر سطر

[ابو جودي]

في 16‏/4‏/2026 at 06:56, أحمد العيسى said:

فى الفلترة : يكفى السطر الثالث ( كل الملفات )

 

ما هو فى المرفق القديم بتاعى كنت عامل كده
بس يبدو لان حضرتك مأخدتش بالك انا عملتها كده فى المرفق الجديد بس علشان اوضح لحضرتك واثبت لك انها تعمل مع كل الاصدارات 
فياريت تتأكد من المرفق باسم : تفعيل وإلغاء الشفت2.mdb اللى حضرتك ارفقته وحتجد اساسا انه مافيهوش اى مشاكل
 

 

في 16‏/4‏/2026 at 06:56, أحمد العيسى said:

بالنسبة لملف   *.accdb   لم ينجح التطبيق فى تغيير الخاصية

اسف انا كتبت الكود وجربته وكان شغال على كل الامتدادت لكل الاصدارات 
ولكن عند المراجعة استوقفنى استخدام : Workspaces

واعتقد ان استخدام  :DBEngine.Workspaces(0) يرث إعدادات محرك المشغل الحالي لذلك يبدو ان حضرتك تستخدم اصدار اقل من 2007 لذلك حدثت هذه المشكلة على ما يبدو 


ودى المرفق الجديد
 

تفعيل وإلغاء الشفت-V2.mdb

[ابو جودي]

اتمنى ان اخر مشاركة لى فى المنتدى واللى كانت من نصيبك يكون فيها الخير والفائدة ان شاء الله لك وللجميع

 

 

[أحمد العيسى]

شكراً  للسادة الأعزاء

Foksh  ، ابو جودي

جاري التجربة لاحقاً  وكتابة الرد على كل منهما

لكن من الواضح أن كل منهما يلبى المطلوب فى حدود اللاحقة mdb  وليس accdb

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

جاري تجربة كلا التطبيقين بتشغيلهما فى بيئة أكسس 7  واختبار التفعيل على  accdb

تم تعديل منذ 1 دقيقه بواسطه أحمد العيسى