مكتبة الموقع - أداة تعميم تنسيق النماذج والتقارير [الجزء الأول] {سلسلة الأدوات المساعدة المخصصة}

[منتصر الانسي]

اعرض الملف

أداة تعميم تنسيق النماذج والتقارير [الجزء الأول] {سلسلة الأدوات المساعدة المخصصة}

---

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

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

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

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

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

تحياتي

---

• صاحب الملف
  منتصر الانسي
• تمت الاضافه
  02/01/26
• الاقسام
  قسم الأكسيس

 

[Debug Ace]

ممتااااااااز استااااااااااااااااااااذ بجد بارك الله فيك

[Moosak]

ما شاء الله تبارك الله .. فعلا كل مرة يفاجئنا الأكسس بمزايا جديدة 😃

شكرا لك أستاذنا @منتصر الانسي شرح مميز ومفصل 🌹

[منتصر الانسي]

شكراً اخي @Debug Ace على الكلام الجميل

والشكور موصول للأخ @Moosak على كلامه وتثبيته للموضوع 🥰

[Debug Ace]

موضوعاتك شيقة وغاية فى الروعة استاذ اتعلم منكم دائما 

كل الشكر والتقدير

هل يمكن ان اساهم فى التطوير بعد اذن حضرتك

[منتصر الانسي]

الان, Debug Ace said:

هل يمكن ان اساهم فى التطوير بعد اذن حضرتك

اكيييد وبدون إستئذان فتبادل الأفكار يثري أي موضوع

[Debug Ace]

11 ساعات مضت, منتصر الانسي said:

اكيييد وبدون إستئذان فتبادل الأفكار يثري أي موضوع

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

اسعد الله صباحكم استاذ

الكود المستخدم داخل النموذج الرئيسي لادارة القوالب


 

Option Compare Database
Option Explicit

'=============================
' إعدادات عامة
'=============================
Private Const TemplateFormPrefix As String = "frmTemplate"
Private Const TemplateComboName As String = "cboFormsTemplateName"
Private TemplateFormManager As String

Private TemplateSnapshot As Object

Private Sub Form_Load()
    TemplateFormManager = Me.Name
    FillTemplateCombo
End Sub

Private Sub FillTemplateCombo()
    Dim i As Long, ao As AccessObject, rs As String, ctl As Control

    Set ctl = Me.Controls(TemplateComboName)
    ctl.RowSourceType = "Value List": ctl.RowSource = ""

    For i = 0 To CurrentProject.AllForms.Count - 1
        Set ao = CurrentProject.AllForms(i)
        If ao.Name Like TemplateFormPrefix & "*" And ao.Name <> TemplateFormManager Then
            rs = IIf(ctl.RowSource = "", ao.Name, ctl.RowSource & ";" & ao.Name)
            ctl.RowSource = rs
        End If
    Next i
End Sub

Private Sub cboFormsTemplateName_AfterUpdate()
    Dim cbo As Control
    Set cbo = Me.Controls(TemplateComboName)

    If IsNull(cbo.Value) Then
        Me.frmChild.SourceObject = ""
    Else
        Me.frmChild.SourceObject = cbo.Value
    End If
    Me.frmChild.Requery
End Sub

'=============================
' تعيين قالب النماذج الافتراضي
'=============================
Public Sub SetFormTemplateName(ByVal templateFormName As String)
    On Error GoTo ErrHandler
    Application.SetOption "Form Template", templateFormName
    Exit Sub
ErrHandler:
    MsgBox "خطأ في تغيير Form Template: " & Err.Number & " - " & Err.Description, vbExclamation
End Sub

Private Sub cmdApplyTemplate_Click()
    Dim cbo As Control
    Set cbo = Me.Controls(TemplateComboName)

    If IsNull(cbo.Value) Then
        MsgBox "اختر قالب أولاً"
        Exit Sub
    End If

    SetFormTemplateName cbo.Value
    PropagateTemplate cbo.Value
    MsgBox "تم تطبيق القالب على جميع النماذج"
End Sub

'=============================
' دوال مساعدة عامة
'=============================
Private Function GetSectionIndex(sec As Integer) As Long
    GetSectionIndex = sec
End Function

Private Function GetControlTypeName(ctrlType As Integer) As String
    Select Case ctrlType
        Case acTextBox:        GetControlTypeName = "TextBox"
        Case acLabel:          GetControlTypeName = "Label"
        Case acComboBox:       GetControlTypeName = "ComboBox"
        Case acCheckBox:       GetControlTypeName = "CheckBox"
        Case acCommandButton:  GetControlTypeName = "CommandButton"
        Case acOptionButton:   GetControlTypeName = "OptionButton"
        Case acToggleButton:   GetControlTypeName = "ToggleButton"
        Case acListBox:        GetControlTypeName = "ListBox"
        Case acSubform:        GetControlTypeName = "Subform"
        Case acTabCtl:         GetControlTypeName = "TabControl"
        Case Else:             GetControlTypeName = "Other"
    End Select
End Function

' قائمة الخصائص المسموح نسخها لكل نوع كنترول
Private Function GetAllowedProps(ctrlTypeName As String) As Variant
    Select Case ctrlTypeName
        Case "TextBox"
            GetAllowedProps = Array("BackColor", "ForeColor", "FontName", "FontSize", _
                                    "FontWeight", "TextAlign", "BorderColor", "BorderStyle")
        Case "Label"
            GetAllowedProps = Array("BackColor", "ForeColor", "FontName", "FontSize", _
                                    "FontWeight", "TextAlign", "BorderColor", "BorderStyle")
        Case "ComboBox"
            GetAllowedProps = Array("BackColor", "ForeColor", "FontName", "FontSize", _
                                    "FontWeight", "BorderColor", "BorderStyle")
        Case "CheckBox", "OptionButton", "ToggleButton"
            GetAllowedProps = Array("BackColor", "ForeColor", "FontName", "FontSize", _
                                    "FontWeight")
        Case "ListBox"
            GetAllowedProps = Array("BackColor", "ForeColor", "FontName", "FontSize", _
                                    "FontWeight", "BorderColor", "BorderStyle")
        Case "CommandButton"
            GetAllowedProps = Array("BackColor", "ForeColor", "FontName", "FontSize", _
                                    "FontWeight", "QuickStyle", "Shape", "BackShade", _
                                    "BackTint", "Gradient", "Glow", "Shadow", "SoftEdges", _
                                    "Width", "Height")
        Case "Subform"
            ' لا نقترب من مصدر الكائن أو روابط الحقول
            GetAllowedProps = Array("BackColor", "BorderColor", "BorderStyle", "SpecialEffect")
        Case Else
            GetAllowedProps = Array()   ' لا نغيّر شيء
    End Select
End Function
'=============================


'=============================
' التقاط خصائص القالب (Snapshot)
Public Function GetTemplateSnapshot(frmName As String) As Object
    Dim snap As Object
    Dim f As Form, ctl As Control, p As Property
    Dim secIndex As Integer, s As Section

    Set snap = CreateObject("Scripting.Dictionary")
    snap.Add "Form", CreateObject("Scripting.Dictionary")
    snap.Add "Sections", CreateObject("Scripting.Dictionary")
    snap.Add "ControlStyles", CreateObject("Scripting.Dictionary")

    DoCmd.OpenForm frmName, acDesign, , , , acHidden
    Set f = Forms(frmName)

    ' خصائص النموذج
    For Each p In f.Properties
        On Error Resume Next
        snap("Form")(p.Name) = p.Value
        On Error GoTo 0
    Next

    ' خصائص السيكشن
    For secIndex = 0 To 5
        On Error Resume Next
        Set s = f.Section(secIndex)
        If Err.Number = 0 Then
            Dim secSnap As Object
            Set secSnap = CreateObject("Scripting.Dictionary")
            For Each p In s.Properties
                On Error Resume Next
                secSnap(p.Name) = p.Value
                On Error GoTo 0
            Next
            snap("Sections").Add CStr(secIndex), secSnap
        End If
        Err.Clear
    Next

    ' أنماط الكنترولز لكل سيكشن/نوع (واحد قالب لكل نوع/سيكشن)
    Dim secKey As String, ctrlTypeName As String
    Dim secDict As Object, styleDict As Object
    Dim allowedProps As Variant, propName As Variant

    For Each ctl In f.Controls
        ctrlTypeName = GetControlTypeName(ctl.ControlType)
        allowedProps = GetAllowedProps(ctrlTypeName)
        If Not IsEmpty(allowedProps) Then
            secKey = CStr(GetSectionIndex(ctl.Section))

            If Not snap("ControlStyles").Exists(secKey) Then
                Set secDict = CreateObject("Scripting.Dictionary")
                snap("ControlStyles").Add secKey, secDict
            Else
                Set secDict = snap("ControlStyles")(secKey)
            End If

            ' أول كنترول من هذا النوع/السيكشن يصبح Template
            If Not secDict.Exists(ctrlTypeName) Then
                Set styleDict = CreateObject("Scripting.Dictionary")
                For Each propName In allowedProps
                    On Error Resume Next
                    styleDict(propName) = ctl.Properties(propName)
                    On Error GoTo 0
                Next
                secDict.Add ctrlTypeName, styleDict
            End If
        End If
    Next

    DoCmd.Close acForm, frmName, acSaveNo
    Set GetTemplateSnapshot = snap
End Function
'=============================


'=============================
' تطبيق Snapshot على نموذج واحد
Public Sub ApplySnapshot(targetForm As String, snap As Object)
    Dim f As Form, ctl As Control
    Dim k As Variant, p As Variant
    Dim secIndex As Variant, sec As Section
    Dim secKey As String, ctrlTypeName As String
    Dim secDict As Object, styleDict As Object
    Dim allowedProps As Variant, propName As Variant

    DoCmd.OpenForm targetForm, acDesign, , , , acHidden
    Set f = Forms(targetForm)

    ' 1) خصائص النموذج
    For Each k In snap("Form").Keys
        On Error Resume Next
        f.Properties(k) = snap("Form")(k)
        On Error GoTo 0
    Next

    ' 2) خصائص السيكشن
    For Each secIndex In snap("Sections").Keys
        On Error Resume Next
        Set sec = f.Section(CLng(secIndex))
        If Err.Number = 0 Then
            For Each p In snap("Sections")(secIndex).Keys
                On Error Resume Next
                sec.Properties(p) = snap("Sections")(secIndex)(p)
                On Error GoTo 0
            Next
        End If
        Err.Clear
    Next

    ' 3) أنماط الكنترولز
    For Each ctl In f.Controls
        ctrlTypeName = GetControlTypeName(ctl.ControlType)
        allowedProps = GetAllowedProps(ctrlTypeName)
        If Not IsEmpty(allowedProps) Then
            secKey = CStr(GetSectionIndex(ctl.Section))

            If snap("ControlStyles").Exists(secKey) Then
                Set secDict = snap("ControlStyles")(secKey)
                If secDict.Exists(ctrlTypeName) Then
                    Set styleDict = secDict(ctrlTypeName)

                    ' تطبيق الخصائص المسموحة
                    For Each propName In allowedProps
                        If styleDict.Exists(propName) Then
                            On Error Resume Next
                            ctl.Properties(propName) = styleDict(propName)
                            On Error GoTo 0
                        End If
                    Next
                End If
            End If
        End If
    Next

    DoCmd.Close acForm, targetForm, acSaveYes
End Sub
'=============================


'=============================
' تطبيق القالب على كل النماذج
Public Sub PropagateTemplate(templateName As String)
    Dim ao As AccessObject

    Set TemplateSnapshot = GetTemplateSnapshot(templateName)

    For Each ao In CurrentProject.AllForms
        If Not ao.Name Like TemplateFormPrefix & "*" Then
            If ao.Name <> TemplateFormManager Then
                ApplySnapshot ao.Name, TemplateSnapshot
            Else
            End If
        Else
        End If
    Next
End Sub
'=============================

اضف اى نماذج كقوالب افتراضية على ان تبدأ بـ : frmTemplate
النموذج الرئيسي لادارة لاختيار وادارة القوالب : frmTemplateManager

عند فتح النموذج سوف يتم جلب واحضار اى نماذج قوالب افتراضية يبدأ اسمها بـ : frmTemplate ويتم ملئ مربع التحرير والسرد بهذه الاسماء
وظيفة مربع التحرير والسرد : استعراض القوالب بمجرد اختيار اى قالب يتم معاينته فى الرئيسية

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

 

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

صورة من نمورج ادارة القوالب

 

اتفضل المرفق استاذ

Mont_FormsTemplatePart02.zip

[Moosak]

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

وربما تكون بذرة لفكرة أكبر .. ألا وهي :

الوضع الليلي والوضع النهاري للبرنامج - Dark mode & light mode

[Debug Ace]

7 ساعات مضت, Moosak said:

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

وربما تكون بذرة لفكرة أكبر

انا منبهر بس مش من البذرة ولا حتى من الفكرة انا منبهر من الطرح والرد

7 ساعات مضت, Moosak said:

ألا وهي :

الوضع الليلي والوضع النهاري للبرنامج - Dark mode & light mode

صمم اى نموذج وابدأ فقط تسميته بـ : frmTemplate ثم اكمل برقم او اى شئ اخر كما يحلو لك ممكن مثلا يكون : frmTemplateDarkMode

فى هذا النموذج حدد اللالوان لجميع العناصر كما تريدها ان تضاهى الـ : Dark mode حسب مخيلتك
وحدد الخصائص العامة التى تريد تورثيها لباقى نماذج القاعدة

كرر نفس الخطوات بعمل نموذج واعطه الاسم : frmTemplateLightMode
فى هذا النموذج حدد اللالوان لجميع العناصر كما تريدها ان تضاهى الـ : Light Mode حسب مخيلتك
وحدد الخصائص العامة التى تريد تورثيها لباقى نماذج القاعدة

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

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

[Debug Ace]

فقط سوف تقوم بتصميم قالب لمرة واحدة فقط وتستخدمه طول العمر ويمكنك التبديل بين القوالب

حتى ان الكود يتعامل مع ازرار الاوامر بشكل خاص لتوريث الشيب والتدرج اللونى ان وجد و ...

يعنى الفكرة دى اتنين X  واحد
تعين قالب رئيسي وادارة ثيمات بقوالب محتلفة 

وما اظنش ان ان الفكرة بالالية دى تم مشاركتها او عرضها لا فى المنتدى ولا حتى فى مواقع الانترنت العربية او الاجنبية....  والله اعلم

تم تعديل منذ 4 ساعات بواسطه Debug Ace

[منتصر الانسي]

ماشاء الله أخ @Debug Ace جئت بفكرة أفضل من التي كانت ببالي (لدي سؤال كيف أن شخص بمهاراتك لم ينضم للمنتدى إلا مؤخراً أين كنت مختفياً 😅؟)

عموما بعد مراجعة عملك خرجت بملاحظة واحدة فقط وهي أنه لايتم تعميم جميع تنسيقات زر الأمر بشكل صحيح شاهد الصورة التالية

لذلك قمت بإضافة بعض العناصر إلى المصفوفة الخاصة بزر الأمر وأصبحت النتيجة كما بالصورة

مرفق الملف بعد التعديل

Mont_FormsTemplatePart02.rar