مطلوب تغيير لون خلفية مقطع تفاصيل النماذج والعناصر دفعة واحدة

[ابو جودي]

السلام عليكم استاذى الجليل و معلمى القدير و والدى الحبيب الاستاذ @ابوخليل 

 

23 ساعات مضت, ابوخليل said:

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

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

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

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

لقد قمت بكتابة الكود بالشكل التالى :

Option Compare Database
Option Explicit

'' ======= التصريحات والثوابت
#If VBA7 Then
    Private Declare PtrSafe Function CHOOSECOLOR Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As CHOOSECOLOR) As Long
#Else
    Private Declare Function CHOOSECOLOR Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As CHOOSECOLOR) As Long
#End If

#If VBA7 Then
    Private Type CHOOSECOLOR
        lStructSize     As Long
        hwndOwner       As LongPtr
        hInstance       As LongPtr
        rgbResult       As Long
        lpCustColors    As LongPtr
        Flags           As Long
        lCustData       As LongPtr
        lpfnHook        As LongPtr
        lpTemplateName  As LongPtr
    End Type
#Else
    Private Type CHOOSECOLOR
        lStructSize     As Long
        hwndOwner       As Long
        hInstance       As Long
        rgbResult       As Long
        lpCustColors    As Long
        Flags           As Long
        lCustData       As Long
        lpfnHook        As Long
        lpTemplateName  As Long
    End Type
#End If

Private Enum SectionType
    stHeader = acHeader
    stDetail = acDetail
    stFooter = acFooter
End Enum

Private Enum ControlType
    ctTextBox = acTextBox
    ctComboBox = acComboBox
    ctListBox = acListBox
    ctLabel = acLabel
    ctCommandButton = acCommandButton
End Enum

Private Const COLOR_UNSET As Long = -1
Private Const TABLE_NAME_THEME_SETTINGS As String = "tblThemeSettings"
Private Const FIELD_NAME As String = "SettingName"
Private Const FIELD_VALUE As String = "SettingValue"

Private Theme As Object
Private DebugMode As Boolean

'' ======= إنشاء القاموس عند بدء التشغيل
Private Sub InitializeThemeDictionary()
    Set Theme = CreateObject("Scripting.Dictionary")
    
    Theme.Add "Header", CreateObject("Scripting.Dictionary")
    Theme("Header").Add "SectionBack", COLOR_UNSET
    Theme("Header").Add "TextBack", COLOR_UNSET
    Theme("Header").Add "TextBorder", COLOR_UNSET
    Theme("Header").Add "TextFont", COLOR_UNSET
    Theme("Header").Add "LabelBack", COLOR_UNSET
    Theme("Header").Add "LabelBorder", COLOR_UNSET
    Theme("Header").Add "LabelFont", COLOR_UNSET
    
    Theme.Add "Detail", CreateObject("Scripting.Dictionary")
    Theme("Detail").Add "SectionBack", COLOR_UNSET
    Theme("Detail").Add "TextBack", COLOR_UNSET
    Theme("Detail").Add "TextBorder", COLOR_UNSET
    Theme("Detail").Add "TextFont", COLOR_UNSET
    Theme("Detail").Add "LabelBack", COLOR_UNSET
    Theme("Detail").Add "LabelBorder", COLOR_UNSET
    Theme("Detail").Add "LabelFont", COLOR_UNSET
    
    Theme.Add "Footer", CreateObject("Scripting.Dictionary")
    Theme("Footer").Add "SectionBack", COLOR_UNSET
    Theme("Footer").Add "TextBack", COLOR_UNSET
    Theme("Footer").Add "TextBorder", COLOR_UNSET
    Theme("Footer").Add "TextFont", COLOR_UNSET
    Theme("Footer").Add "LabelBack", COLOR_UNSET
    Theme("Footer").Add "LabelBorder", COLOR_UNSET
    Theme("Footer").Add "LabelFont", COLOR_UNSET
    
    Theme.Add "Button", CreateObject("Scripting.Dictionary")
    Theme("Button").Add "Back", COLOR_UNSET
    Theme("Button").Add "Border", COLOR_UNSET
    Theme("Button").Add "Font", COLOR_UNSET
    Theme("Button").Add "Hover", COLOR_UNSET
    Theme("Button").Add "Pressed", COLOR_UNSET
    Theme("Button").Add "HoverFore", COLOR_UNSET
    Theme("Button").Add "PressedFore", COLOR_UNSET
    
    Theme.Add "Combo", CreateObject("Scripting.Dictionary")
    Theme("Combo").Add "Back", COLOR_UNSET
    Theme("Combo").Add "Border", COLOR_UNSET
    Theme("Combo").Add "Font", COLOR_UNSET
    
    Theme.Add "List", CreateObject("Scripting.Dictionary")
    Theme("List").Add "Back", COLOR_UNSET
    Theme("List").Add "Border", COLOR_UNSET
    Theme("List").Add "Font", COLOR_UNSET
End Sub


'' ======= أحداث النموذج
Private Sub Form_Load()
    InitializeThemeDictionary
    EnsureThemeTableExists
    LoadThemeFromTable
End Sub

Private Sub btnSaveAndApply_Click()
    SaveThemeToTable
    ApplyThemeToAllForms
    MsgBox "تم تطبيق الثيم بنجاح.", vbInformation
End Sub

Private Sub btnApplyDefaultThemeToCurrentForm_Click()
    SetDefaultThemeValues
    ApplyThemePreview
End Sub

'' ======= أزرار تغيير الألوان
Private Sub btnHeaderSectionColor_Click()
    Dim lngColor As Long
    lngColor = Theme("Header")("SectionBack")
    ApplySectionColor lngColor, stHeader
    Theme("Header")("SectionBack") = lngColor
    ApplyThemePreview
End Sub
Private Sub btnHeaderControlBack_Click()
    Dim lngColor As Long
    lngColor = Theme("Header")("TextBack")
    HandleColorPick lngColor, "BackColor", ctTextBox, stHeader
    Theme("Header")("TextBack") = lngColor
    ApplyThemePreview
End Sub
Private Sub btnHeaderControlBorder_Click()
    Dim lngColor As Long
    lngColor = Theme("Header")("TextBorder")
    HandleColorPick lngColor, "BorderColor", ctTextBox, stHeader
    Theme("Header")("TextBorder") = lngColor
    ApplyThemePreview
End Sub
Private Sub btnHeaderControlFore_Click()
    Dim lngColor As Long
    lngColor = Theme("Header")("TextFont")
    HandleColorPick lngColor, "ForeColor", ctTextBox, stHeader
    Theme("Header")("TextFont") = lngColor
    ApplyThemePreview
End Sub
Private Sub btnHeaderLabelBack_Click()
    Dim lngColor As Long
    lngColor = Theme("Header")("LabelBack")
    HandleColorPick lngColor, "BackColor", ctLabel, stHeader
    Theme("Header")("LabelBack") = lngColor
    ApplyThemePreview
End Sub
Private Sub btnHeaderLabelBorder_Click()
    Dim lngColor As Long
    lngColor = Theme("Header")("LabelBorder")
    HandleColorPick lngColor, "BorderColor", ctLabel, stHeader
    Theme("Header")("LabelBorder") = lngColor
    ApplyThemePreview
End Sub
Private Sub btnHeaderLabelFore_Click()
    Dim lngColor As Long
    lngColor = Theme("Header")("LabelFont")
    HandleColorPick lngColor, "ForeColor", ctLabel, stHeader
    Theme("Header")("LabelFont") = lngColor
    ApplyThemePreview
End Sub
Private Sub btnDetailSectionColor_Click()
    Dim lngColor As Long
    lngColor = Theme("Detail")("SectionBack")
    ApplySectionColor lngColor, stDetail
    Theme("Detail")("SectionBack") = lngColor
    ApplyThemePreview
End Sub
Private Sub btnDetailControlBack_Click()
    Dim lngColor As Long
    lngColor = Theme("Detail")("TextBack")
    HandleColorPick lngColor, "BackColor", ctTextBox, stDetail
    Theme("Detail")("TextBack") = lngColor
    ApplyThemePreview
End Sub
Private Sub btnDetailControlBorder_Click()
    Dim lngColor As Long
    lngColor = Theme("Detail")("TextBorder")
    HandleColorPick lngColor, "BorderColor", ctTextBox, stDetail
    Theme("Detail")("TextBorder") = lngColor
    ApplyThemePreview
End Sub
Private Sub btnDetailControlFore_Click()
    Dim lngColor As Long
    lngColor = Theme("Detail")("TextFont")
    HandleColorPick lngColor, "ForeColor", ctTextBox, stDetail
    Theme("Detail")("TextFont") = lngColor
    ApplyThemePreview
End Sub
Private Sub btnDetailLabelBack_Click()
    Dim lngColor As Long
    lngColor = Theme("Detail")("LabelBack")
    HandleColorPick lngColor, "BackColor", ctLabel, stDetail
    Theme("Detail")("LabelBack") = lngColor
    ApplyThemePreview
End Sub
Private Sub btnDetailLabelBorder_Click()
    Dim lngColor As Long
    lngColor = Theme("Detail")("LabelBorder")
    HandleColorPick lngColor, "BorderColor", ctLabel, stDetail
    Theme("Detail")("LabelBorder") = lngColor
    ApplyThemePreview
End Sub
Private Sub btnDetailLabelFore_Click()
    Dim lngColor As Long
    lngColor = Theme("Detail")("LabelFont")
    HandleColorPick lngColor, "ForeColor", ctLabel, stDetail
    Theme("Detail")("LabelFont") = lngColor
    ApplyThemePreview
End Sub

Private Sub btnFooterSectionColor_Click()
    Dim lngColor As Long
    lngColor = Theme("Footer")("SectionBack")
    ApplySectionColor lngColor, stFooter
    Theme("Footer")("SectionBack") = lngColor
    ApplyThemePreview
End Sub
Private Sub btnFooterControlBack_Click()
    Dim lngColor As Long
    lngColor = Theme("Footer")("TextBack")
    HandleColorPick lngColor, "BackColor", ctTextBox, stFooter
    Theme("Footer")("TextBack") = lngColor
    ApplyThemePreview
End Sub
Private Sub btnFooterControlBorder_Click()
    Dim lngColor As Long
    lngColor = Theme("Footer")("TextBorder")
    HandleColorPick lngColor, "BorderColor", ctTextBox, stFooter
    Theme("Footer")("TextBorder") = lngColor
    ApplyThemePreview
End Sub
Private Sub btnFooterControlFore_Click()
    Dim lngColor As Long
    lngColor = Theme("Footer")("TextFont")
    HandleColorPick lngColor, "ForeColor", ctTextBox, stFooter
    Theme("Footer")("TextFont") = lngColor
    ApplyThemePreview
End Sub
Private Sub btnFooterLabelBack_Click()
    Dim lngColor As Long
    lngColor = Theme("Footer")("LabelBack")
    HandleColorPick lngColor, "BackColor", ctLabel, stFooter
    Theme("Footer")("LabelBack") = lngColor
    ApplyThemePreview
End Sub
Private Sub btnFooterLabelBorder_Click()
    Dim lngColor As Long
    lngColor = Theme("Footer")("LabelBorder")
    HandleColorPick lngColor, "BorderColor", ctLabel, stFooter
    Theme("Footer")("LabelBorder") = lngColor
    ApplyThemePreview
End Sub
Private Sub btnFooterLabelFore_Click()
    Dim lngColor As Long
    lngColor = Theme("Footer")("LabelFont")
    HandleColorPick lngColor, "ForeColor", ctLabel, stFooter
    Theme("Footer")("LabelFont") = lngColor
    ApplyThemePreview
End Sub

Private Sub btnCommandBack_Click()
    Dim lngColor As Long
    lngColor = Theme("Button")("Back")
    HandleColorPick lngColor, "BackColor", ctCommandButton
    Theme("Button")("Back") = lngColor
    ApplyThemePreview
End Sub
Private Sub btnCommandBorder_Click()
    Dim lngColor As Long
    lngColor = Theme("Button")("Border")
    HandleColorPick lngColor, "BorderColor", ctCommandButton
    Theme("Button")("Border") = lngColor
    ApplyThemePreview
End Sub
Private Sub btnCommandFore_Click()
    Dim lngColor As Long
    lngColor = Theme("Button")("Font")
    HandleColorPick lngColor, "ForeColor", ctCommandButton
    Theme("Button")("Font") = lngColor
    ApplyThemePreview
End Sub
Private Sub btnCommandHover_Click()
    Dim lngColor As Long
    lngColor = Theme("Button")("Hover")
    lngColor = PickColorFromBase(lngColor)
    Theme("Button")("Hover") = lngColor
    ApplyThemePreview
End Sub
Private Sub btnCommandPressed_Click()
    Dim lngColor As Long
    lngColor = Theme("Button")("Pressed")
    lngColor = PickColorFromBase(lngColor)
    Theme("Button")("Pressed") = lngColor
    ApplyThemePreview
End Sub
Private Sub btnCommandHoverFore_Click()
    Dim lngColor As Long
    lngColor = Theme("Button")("HoverFore")
    lngColor = PickColorFromBase(lngColor)
    Theme("Button")("HoverFore") = lngColor
    ApplyThemePreview
End Sub
Private Sub btnCommandPressedFore_Click()
    Dim lngColor As Long
    lngColor = Theme("Button")("PressedFore")
    lngColor = PickColorFromBase(lngColor)
    Theme("Button")("PressedFore") = lngColor
    ApplyThemePreview
End Sub

Private Sub btnComboBack_Click()
    Dim lngColor As Long
    lngColor = Theme("Combo")("Back")
    HandleColorPick lngColor, "BackColor", ctComboBox
    Theme("Combo")("Back") = lngColor
    ApplyThemePreview
End Sub
Private Sub btnComboBorder_Click()
    Dim lngColor As Long
    lngColor = Theme("Combo")("Border")
    HandleColorPick lngColor, "BorderColor", ctComboBox
    Theme("Combo")("Border") = lngColor
    ApplyThemePreview
End Sub
Private Sub btnComboFore_Click()
    Dim lngColor As Long
    lngColor = Theme("Combo")("Font")
    HandleColorPick lngColor, "ForeColor", ctComboBox
    Theme("Combo")("Font") = lngColor
    ApplyThemePreview
End Sub

Private Sub btnListBack_Click()
    Dim lngColor As Long
    lngColor = Theme("List")("Back")
    HandleColorPick lngColor, "BackColor", ctListBox
    Theme("List")("Back") = lngColor
    ApplyThemePreview
End Sub
Private Sub btnListBorder_Click()
    Dim lngColor As Long
    lngColor = Theme("List")("Border")
    HandleColorPick lngColor, "BorderColor", ctListBox
    Theme("List")("Border") = lngColor
    ApplyThemePreview
End Sub
Private Sub btnListFore_Click()
    Dim lngColor As Long
    lngColor = Theme("List")("Font")
    HandleColorPick lngColor, "ForeColor", ctListBox
    Theme("List")("Font") = lngColor
    ApplyThemePreview
End Sub

'' ======= قيم افتراضية
Private Sub SetDefaultThemeValues()
    Theme("Header")("SectionBack") = RGB(230, 230, 250)
    Theme("Header")("TextBack") = RGB(255, 255, 255)
    Theme("Header")("TextBorder") = RGB(180, 180, 180)
    Theme("Header")("TextFont") = RGB(0, 0, 0)
    Theme("Header")("LabelBack") = RGB(240, 240, 240)
    Theme("Header")("LabelBorder") = RGB(240, 240, 240)
    Theme("Header")("LabelFont") = RGB(0, 0, 0)
    
    Theme("Detail")("SectionBack") = RGB(255, 255, 255)
    Theme("Detail")("TextBack") = RGB(255, 255, 255)
    Theme("Detail")("TextBorder") = RGB(180, 180, 180)
    Theme("Detail")("TextFont") = RGB(0, 0, 0)
    Theme("Detail")("LabelBack") = RGB(240, 240, 240)
    Theme("Detail")("LabelBorder") = RGB(240, 240, 240)
    Theme("Detail")("LabelFont") = RGB(0, 0, 0)
    
    Theme("Footer")("SectionBack") = RGB(245, 245, 245)
    Theme("Footer")("TextBack") = RGB(255, 255, 255)
    Theme("Footer")("TextBorder") = RGB(180, 180, 180)
    Theme("Footer")("TextFont") = RGB(0, 0, 0)
    Theme("Footer")("LabelBack") = RGB(240, 240, 240)
    Theme("Footer")("LabelBorder") = RGB(240, 240, 240)
    Theme("Footer")("LabelFont") = RGB(0, 0, 0)
    
    Theme("Button")("Back") = RGB(220, 220, 220)
    Theme("Button")("Border") = RGB(180, 180, 180)
    Theme("Button")("Font") = RGB(0, 0, 0)
    Theme("Button")("Hover") = RGB(200, 200, 255)
    Theme("Button")("Pressed") = RGB(150, 150, 220)
    Theme("Button")("HoverFore") = RGB(0, 0, 80)
    Theme("Button")("PressedFore") = RGB(255, 255, 255)
    
    Theme("Combo")("Back") = RGB(255, 255, 255)
    Theme("Combo")("Border") = RGB(160, 160, 160)
    Theme("Combo")("Font") = RGB(0, 0, 0)
    
    Theme("List")("Back") = RGB(255, 255, 255)
    Theme("List")("Border") = RGB(180, 180, 180)
    Theme("List")("Font") = RGB(0, 0, 0)
End Sub

'' ======= دوال مساعدة
Private Function PickColorFromBase(Optional ByVal lngStartColor As Long = -1) As Long
    Dim cc As CHOOSECOLOR
    Dim aColors(15) As Long

    cc.lStructSize = LenB(cc)
    cc.hwndOwner = Application.hWndAccessApp
    cc.lpCustColors = VarPtr(aColors(0))

    If lngStartColor <> -1 Then
        cc.rgbResult = lngStartColor
        cc.Flags = &H1
    End If

    If CHOOSECOLOR(cc) Then
        PickColorFromBase = cc.rgbResult
    Else
        PickColorFromBase = COLOR_UNSET
    End If
End Function

Private Sub HandleColorPick(ByRef lngTargetVar As Long, ByVal strProperty As String, ByVal lngControlType As Long, Optional ByVal lngSection As Variant)
    Dim lngNewColor As Long
    Dim ctl As Control
    Dim bolMatchSection As Boolean

    lngNewColor = PickColorFromBase(lngTargetVar)
    If lngNewColor = COLOR_UNSET Then Exit Sub
    lngTargetVar = lngNewColor

    For Each ctl In Me.Controls
        If ctl.ControlType = lngControlType Then
            On Error Resume Next
            bolMatchSection = (IsMissing(lngSection) Or ctl.section = lngSection)
            On Error GoTo 0

            If bolMatchSection Then
                On Error Resume Next
                CallByName ctl, strProperty, VbLet, lngNewColor
                On Error GoTo 0
            End If
        End If
    Next ctl
End Sub

Private Sub ApplySectionColor(ByRef lngTargetVar As Long, ByVal lngSection As Long)
    Dim lngNewColor As Long
    lngNewColor = PickColorFromBase(lngTargetVar)
    If lngNewColor <> COLOR_UNSET Then
        lngTargetVar = lngNewColor
        Me.section(lngSection).BackColor = lngNewColor
    End If
End Sub

Private Sub ApplyThemePreview()
    Dim ctl As Control
    Dim sec As String
    
    If Theme("Header")("SectionBack") <> COLOR_UNSET Then Me.section(stHeader).BackColor = Theme("Header")("SectionBack")
    If Theme("Detail")("SectionBack") <> COLOR_UNSET Then Me.section(stDetail).BackColor = Theme("Detail")("SectionBack")
    If Theme("Footer")("SectionBack") <> COLOR_UNSET Then Me.section(stFooter).BackColor = Theme("Footer")("SectionBack")

    For Each ctl In Me.Controls
        Select Case ctl.ControlType
            Case ctTextBox
                Select Case ctl.section
                    Case stHeader: sec = "Header"
                    Case stDetail: sec = "Detail"
                    Case stFooter: sec = "Footer"
                    Case Else: GoTo NextControl
                End Select
                If Theme(sec)("TextBack") <> COLOR_UNSET Then ctl.BackColor = Theme(sec)("TextBack")
                If Theme(sec)("TextBorder") <> COLOR_UNSET Then ctl.BorderColor = Theme(sec)("TextBorder")
                If Theme(sec)("TextFont") <> COLOR_UNSET Then ctl.ForeColor = Theme(sec)("TextFont")
                
            Case ctComboBox
                If Theme("Combo")("Back") <> COLOR_UNSET Then ctl.BackColor = Theme("Combo")("Back")
                If Theme("Combo")("Border") <> COLOR_UNSET Then ctl.BorderColor = Theme("Combo")("Border")
                If Theme("Combo")("Font") <> COLOR_UNSET Then ctl.ForeColor = Theme("Combo")("Font")
                
            Case ctListBox
                If Theme("List")("Back") <> COLOR_UNSET Then ctl.BackColor = Theme("List")("Back")
                If Theme("List")("Border") <> COLOR_UNSET Then ctl.BorderColor = Theme("List")("Border")
                If Theme("List")("Font") <> COLOR_UNSET Then ctl.ForeColor = Theme("List")("Font")
                
            Case ctLabel
                Select Case ctl.section
                    Case stHeader: sec = "Header"
                    Case stDetail: sec = "Detail"
                    Case stFooter: sec = "Footer"
                    Case Else: GoTo NextControl
                End Select
                If Theme(sec)("LabelBack") <> COLOR_UNSET Then ctl.BackColor = Theme(sec)("LabelBack")
                If Theme(sec)("LabelBorder") <> COLOR_UNSET Then ctl.BorderColor = Theme(sec)("LabelBorder")
                If Theme(sec)("LabelFont") <> COLOR_UNSET Then ctl.ForeColor = Theme(sec)("LabelFont")
                
            Case ctCommandButton
                If Theme("Button")("Back") <> COLOR_UNSET Then ctl.BackColor = Theme("Button")("Back")
                If Theme("Button")("Border") <> COLOR_UNSET Then ctl.BorderColor = Theme("Button")("Border")
                If Theme("Button")("Font") <> COLOR_UNSET Then ctl.ForeColor = Theme("Button")("Font")
                On Error Resume Next
                If Theme("Button")("Hover") <> COLOR_UNSET Then ctl.HoverColor = Theme("Button")("Hover")
                If Theme("Button")("Pressed") <> COLOR_UNSET Then ctl.PressedColor = Theme("Button")("Pressed")
                If Theme("Button")("HoverFore") <> COLOR_UNSET Then ctl.HoverForeColor = Theme("Button")("HoverFore")
                If Theme("Button")("PressedFore") <> COLOR_UNSET Then ctl.PressedForeColor = Theme("Button")("PressedFore")
                On Error GoTo 0
        End Select
NextControl:
    Next ctl
End Sub

Private Sub EnsureThemeTableExists()
    Dim db As DAO.Database
    Dim tdf As DAO.TableDef

    Set db = CurrentDb
    On Error Resume Next
    Set tdf = db.TableDefs(TABLE_NAME_THEME_SETTINGS)
    On Error GoTo 0

    If tdf Is Nothing Then
        db.Execute "CREATE TABLE " & TABLE_NAME_THEME_SETTINGS & " (" & _
            FIELD_NAME & " TEXT(50) PRIMARY KEY, " & _
            FIELD_VALUE & " LONG)", dbFailOnError
    End If
End Sub

Private Sub SaveColorSetting(ByRef rs As DAO.Recordset, ByVal strName As String, ByVal lngValue As Long)
    rs.FindFirst FIELD_NAME & "='" & strName & "'"
    If rs.NoMatch Then
        rs.AddNew
        rs(FIELD_NAME) = strName
        rs(FIELD_VALUE) = lngValue
        rs.Update
    ElseIf rs(FIELD_VALUE) <> lngValue Then
        rs.Edit
        rs(FIELD_VALUE) = lngValue
        rs.Update
    End If
End Sub

Private Sub SaveThemeToTable()
    Dim rs As DAO.Recordset
    Set rs = CurrentDb.OpenRecordset(TABLE_NAME_THEME_SETTINGS, dbOpenDynaset)

    SaveColorSetting rs, "Header_SectionBack", Theme("Header")("SectionBack")
    SaveColorSetting rs, "Header_TextBack", Theme("Header")("TextBack")
    SaveColorSetting rs, "Header_TextBorder", Theme("Header")("TextBorder")
    SaveColorSetting rs, "Header_TextFont", Theme("Header")("TextFont")
    SaveColorSetting rs, "Header_LabelBack", Theme("Header")("LabelBack")
    SaveColorSetting rs, "Header_LabelBorder", Theme("Header")("LabelBorder")
    SaveColorSetting rs, "Header_LabelFont", Theme("Header")("LabelFont")
    
    SaveColorSetting rs, "Detail_SectionBack", Theme("Detail")("SectionBack")
    SaveColorSetting rs, "Detail_TextBack", Theme("Detail")("TextBack")
    SaveColorSetting rs, "Detail_TextBorder", Theme("Detail")("TextBorder")
    SaveColorSetting rs, "Detail_TextFont", Theme("Detail")("TextFont")
    SaveColorSetting rs, "Detail_LabelBack", Theme("Detail")("LabelBack")
    SaveColorSetting rs, "Detail_LabelBorder", Theme("Detail")("LabelBorder")
    SaveColorSetting rs, "Detail_LabelFont", Theme("Detail")("LabelFont")
    
    SaveColorSetting rs, "Footer_SectionBack", Theme("Footer")("SectionBack")
    SaveColorSetting rs, "Footer_TextBack", Theme("Footer")("TextBack")
    SaveColorSetting rs, "Footer_TextBorder", Theme("Footer")("TextBorder")
    SaveColorSetting rs, "Footer_TextFont", Theme("Footer")("TextFont")
    SaveColorSetting rs, "Footer_LabelBack", Theme("Footer")("LabelBack")
    SaveColorSetting rs, "Footer_LabelBorder", Theme("Footer")("LabelBorder")
    SaveColorSetting rs, "Footer_LabelFont", Theme("Footer")("LabelFont")
    
    SaveColorSetting rs, "Button_Back", Theme("Button")("Back")
    SaveColorSetting rs, "Button_Border", Theme("Button")("Border")
    SaveColorSetting rs, "Button_Font", Theme("Button")("Font")
    SaveColorSetting rs, "Button_Hover", Theme("Button")("Hover")
    SaveColorSetting rs, "Button_Pressed", Theme("Button")("Pressed")
    SaveColorSetting rs, "Button_HoverFore", Theme("Button")("HoverFore")
    SaveColorSetting rs, "Button_PressedFore", Theme("Button")("PressedFore")
    
    SaveColorSetting rs, "Combo_Back", Theme("Combo")("Back")
    SaveColorSetting rs, "Combo_Border", Theme("Combo")("Border")
    SaveColorSetting rs, "Combo_Font", Theme("Combo")("Font")
    
    SaveColorSetting rs, "List_Back", Theme("List")("Back")
    SaveColorSetting rs, "List_Border", Theme("List")("Border")
    SaveColorSetting rs, "List_Font", Theme("List")("Font")

    rs.Close
End Sub

Private Sub LoadThemeFromCurrentForm()
    Dim ctl As Control
    Dim sec As String
    
    Theme("Header")("SectionBack") = Me.section(stHeader).BackColor
    Theme("Detail")("SectionBack") = Me.section(stDetail).BackColor
    Theme("Footer")("SectionBack") = Me.section(stFooter).BackColor

    For Each ctl In Me.Controls
        Select Case ctl.ControlType
            Case ctTextBox
                Select Case ctl.section
                    Case stHeader: sec = "Header"
                    Case stDetail: sec = "Detail"
                    Case stFooter: sec = "Footer"
                    Case Else: GoTo NextControl
                End Select
                Theme(sec)("TextBack") = ctl.BackColor
                Theme(sec)("TextBorder") = ctl.BorderColor
                Theme(sec)("TextFont") = ctl.ForeColor
                
            Case ctComboBox
                Theme("Combo")("Back") = ctl.BackColor
                Theme("Combo")("Border") = ctl.BorderColor
                Theme("Combo")("Font") = ctl.ForeColor
                
            Case ctListBox
                Theme("List")("Back") = ctl.BackColor
                Theme("List")("Border") = ctl.BorderColor
                Theme("List")("Font") = ctl.ForeColor
                
            Case ctLabel
                Select Case ctl.section
                    Case stHeader: sec = "Header"
                    Case stDetail: sec = "Detail"
                    Case stFooter: sec = "Footer"
                    Case Else: GoTo NextControl
                End Select
                Theme(sec)("LabelBack") = ctl.BackColor
                Theme(sec)("LabelBorder") = ctl.BorderColor
                Theme(sec)("LabelFont") = ctl.ForeColor
                
            Case ctCommandButton
                Theme("Button")("Back") = ctl.BackColor
                Theme("Button")("Border") = ctl.BorderColor
                Theme("Button")("Font") = ctl.ForeColor
                On Error Resume Next
                Theme("Button")("Hover") = ctl.HoverColor
                Theme("Button")("Pressed") = ctl.PressedColor
                Theme("Button")("HoverFore") = ctl.HoverForeColor
                Theme("Button")("PressedFore") = ctl.PressedForeColor
                On Error GoTo 0
        End Select
NextControl:
    Next ctl
End Sub

Private Sub LoadThemeFromTable()
    Dim rs As DAO.Recordset
    On Error GoTo ErrHandler

    Set rs = CurrentDb.OpenRecordset("SELECT * FROM " & TABLE_NAME_THEME_SETTINGS)
    
    If rs.EOF Then
        LoadThemeFromCurrentForm
    Else
        Do Until rs.EOF
            Select Case rs(FIELD_NAME)
                Case "Header_SectionBack": Theme("Header")("SectionBack") = rs(FIELD_VALUE)
                Case "Header_TextBack": Theme("Header")("TextBack") = rs(FIELD_VALUE)
                Case "Header_TextBorder": Theme("Header")("TextBorder") = rs(FIELD_VALUE)
                Case "Header_TextFont": Theme("Header")("TextFont") = rs(FIELD_VALUE)
                Case "Header_LabelBack": Theme("Header")("LabelBack") = rs(FIELD_VALUE)
                Case "Header_LabelBorder": Theme("Header")("LabelBorder") = rs(FIELD_VALUE)
                Case "Header_LabelFont": Theme("Header")("LabelFont") = rs(FIELD_VALUE)
                
                Case "Detail_SectionBack": Theme("Detail")("SectionBack") = rs(FIELD_VALUE)
                Case "Detail_TextBack": Theme("Detail")("TextBack") = rs(FIELD_VALUE)
                Case "Detail_TextBorder": Theme("Detail")("TextBorder") = rs(FIELD_VALUE)
                Case "Detail_TextFont": Theme("Detail")("TextFont") = rs(FIELD_VALUE)
                Case "Detail_LabelBack": Theme("Detail")("LabelBack") = rs(FIELD_VALUE)
                Case "Detail_LabelBorder": Theme("Detail")("LabelBorder") = rs(FIELD_VALUE)
                Case "Detail_LabelFont": Theme("Detail")("LabelFont") = rs(FIELD_VALUE)
                
                Case "Footer_SectionBack": Theme("Footer")("SectionBack") = rs(FIELD_VALUE)
                Case "Footer_TextBack": Theme("Footer")("TextBack") = rs(FIELD_VALUE)
                Case "Footer_TextBorder": Theme("Footer")("TextBorder") = rs(FIELD_VALUE)
                Case "Footer_TextFont": Theme("Footer")("TextFont") = rs(FIELD_VALUE)
                Case "Footer_LabelBack": Theme("Footer")("LabelBack") = rs(FIELD_VALUE)
                Case "Footer_LabelBorder": Theme("Footer")("LabelBorder") = rs(FIELD_VALUE)
                Case "Footer_LabelFont": Theme("Footer")("LabelFont") = rs(FIELD_VALUE)
                
                Case "Button_Back": Theme("Button")("Back") = rs(FIELD_VALUE)
                Case "Button_Border": Theme("Button")("Border") = rs(FIELD_VALUE)
                Case "Button_Font": Theme("Button")("Font") = rs(FIELD_VALUE)
                Case "Button_Hover": Theme("Button")("Hover") = rs(FIELD_VALUE)
                Case "Button_Pressed": Theme("Button")("Pressed") = rs(FIELD_VALUE)
                Case "Button_HoverFore": Theme("Button")("HoverFore") = rs(FIELD_VALUE)
                Case "Button_PressedFore": Theme("Button")("PressedFore") = rs(FIELD_VALUE)
                
                Case "Combo_Back": Theme("Combo")("Back") = rs(FIELD_VALUE)
                Case "Combo_Border": Theme("Combo")("Border") = rs(FIELD_VALUE)
                Case "Combo_Font": Theme("Combo")("Font") = rs(FIELD_VALUE)
                
                Case "List_Back": Theme("List")("Back") = rs(FIELD_VALUE)
                Case "List_Border": Theme("List")("Border") = rs(FIELD_VALUE)
                Case "List_Font": Theme("List")("Font") = rs(FIELD_VALUE)
            End Select
            rs.MoveNext
        Loop
    End If

    rs.Close
    Set rs = Nothing
    ApplyThemePreview
    Exit Sub

ErrHandler:
    If DebugMode Then Debug.Print "LoadThemeFromTable >> " & Err.Number & ": " & Err.Description
End Sub

Private Sub ApplyThemeToAllForms()
    Dim frm As Object
    Dim ctl As Control
    Dim i As Integer
    Dim arrSections As Variant
    Dim sec As section
    Dim secName As String

    arrSections = Array(stHeader, stDetail, stFooter)

    For Each frm In CurrentProject.AllForms
        On Error Resume Next
        DoCmd.OpenForm frm.Name, acDesign, , , , acHidden
        If Err.Number <> 0 Then
            If DebugMode Then Debug.Print "تعذر فتح النموذج: " & frm.Name
            Err.Clear
            GoTo NextForm
        End If
        On Error GoTo 0

        For i = LBound(arrSections) To UBound(arrSections)
            Set sec = Forms(frm.Name).section(arrSections(i))
            Select Case arrSections(i)
                Case stHeader: If Theme("Header")("SectionBack") <> COLOR_UNSET Then sec.BackColor = Theme("Header")("SectionBack")
                Case stDetail: If Theme("Detail")("SectionBack") <> COLOR_UNSET Then sec.BackColor = Theme("Detail")("SectionBack")
                Case stFooter: If Theme("Footer")("SectionBack") <> COLOR_UNSET Then sec.BackColor = Theme("Footer")("SectionBack")
            End Select
        Next i

        For Each ctl In Forms(frm.Name).Controls
            Select Case ctl.ControlType
                Case ctTextBox
                    Select Case ctl.section
                        Case stHeader: secName = "Header"
                        Case stDetail: secName = "Detail"
                        Case stFooter: secName = "Footer"
                        Case Else: GoTo NextControl
                    End Select
                    If Theme(secName)("TextBack") <> COLOR_UNSET Then ctl.BackColor = Theme(secName)("TextBack")
                    If Theme(secName)("TextBorder") <> COLOR_UNSET Then ctl.BorderColor = Theme(secName)("TextBorder")
                    If Theme(secName)("TextFont") <> COLOR_UNSET Then ctl.ForeColor = Theme(secName)("TextFont")
                    
                Case ctComboBox
                    If Theme("Combo")("Back") <> COLOR_UNSET Then ctl.BackColor = Theme("Combo")("Back")
                    If Theme("Combo")("Border") <> COLOR_UNSET Then ctl.BorderColor = Theme("Combo")("Border")
                    If Theme("Combo")("Font") <> COLOR_UNSET Then ctl.ForeColor = Theme("Combo")("Font")
                    
                Case ctListBox
                    If Theme("List")("Back") <> COLOR_UNSET Then ctl.BackColor = Theme("List")("Back")
                    If Theme("List")("Border") <> COLOR_UNSET Then ctl.BorderColor = Theme("List")("Border")
                    If Theme("List")("Font") <> COLOR_UNSET Then ctl.ForeColor = Theme("List")("Font")
                    
                Case ctLabel
                    Select Case ctl.section
                        Case stHeader: secName = "Header"
                        Case stDetail: secName = "Detail"
                        Case stFooter: secName = "Footer"
                        Case Else: GoTo NextControl
                    End Select
                    If Theme(secName)("LabelBack") <> COLOR_UNSET Then ctl.BackColor = Theme(secName)("LabelBack")
                    If Theme(secName)("LabelBorder") <> COLOR_UNSET Then ctl.BorderColor = Theme(secName)("LabelBorder")
                    If Theme(secName)("LabelFont") <> COLOR_UNSET Then ctl.ForeColor = Theme(secName)("LabelFont")
                    
                Case ctCommandButton
                    If Theme("Button")("Back") <> COLOR_UNSET Then ctl.BackColor = Theme("Button")("Back")
                    If Theme("Button")("Border") <> COLOR_UNSET Then ctl.BorderColor = Theme("Button")("Border")
                    If Theme("Button")("Font") <> COLOR_UNSET Then ctl.ForeColor = Theme("Button")("Font")
                    On Error Resume Next
                    If Theme("Button")("Hover") <> COLOR_UNSET Then ctl.HoverColor = Theme("Button")("Hover")
                    If Theme("Button")("Pressed") <> COLOR_UNSET Then ctl.PressedColor = Theme("Button")("Pressed")
                    If Theme("Button")("HoverFore") <> COLOR_UNSET Then ctl.HoverForeColor = Theme("Button")("HoverFore")
                    If Theme("Button")("PressedFore") <> COLOR_UNSET Then ctl.PressedForeColor = Theme("Button")("PressedFore")
                    On Error GoTo 0
            End Select
NextControl:
        Next ctl

        DoCmd.Close acForm, frm.Name, acSaveYes
NextForm:
        On Error GoTo 0
        Err.Clear
    Next frm
End Sub

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



وأخيرا التعديل على مرفق حضرتك

 

changColor(2).accdb

[ابوخليل]

نعم .. نعم .. هو كذا يا باشمهندس

كذا الشغل والا بلاش .. سلمت أناملك .. وفكرك

[ابو جودي]

3 دقائق مضت, ابوخليل said:

نعم .. نعم .. هو كذا يا باشمهندس

كذا الشغل والا بلاش .. سلمت أناملك .. وفكرك

ادامك الله فوق رؤسنا وحفظكم لنا ولأحبابكم

الحمد لله الذى تتم بنعمته الصالحات

[ابو البشر]

شكرا لاخي @ابو جودي سبقني بالحل الناجع .............................

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

- اختيار نموذج من القاعدة الحالية او نموذج القاعدة الخارجية لمعاينة الشكل ( طبعا المعاينة لا تغير من خصائص عناصر النموذج ولكن للمشاهدة فقط) 

- يمكن تعديل الشكل ومعاينة النموذج المختار

- بعد اختيار الشكل المناسب يتم الضغط عل تطبيق فيتم تطبيق الشكل على كامل النماذج في القاعدة ( سواءا الحالية _ او الخارخية )

- للاسف لم يسعفني الوقت لاكمال التصميم بسبب انشغالي هذه الفترة
 

[ابو جودي]

36 دقائق مضت, ابو البشر said:

- للاسف لم يسعفني الوقت لاكمال التصميم بسبب انشغالي هذه الفترة

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