VBA Tipp: Formatierung und Validierung von Formularen über eine Klasse

Aus DBWiki
Wechseln zu: Navigation, Suche

Aufgabenstellung

Formulare sollen einheitlich formatiert werden und leere Felder müssen kenntlich gemacht werden. Aus dieser Aufgabenstellung heraus enstand die Klasse BW_FormHelper. Mit der Klasse ist es möglich Formulare innerhalb einer Anwendung zu formatieren (ähnlich wie in CSS) und Validierungen auf leere Felder durchzuführen.

Codebeispiel

Option Explicit
 
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
'===========================================================================================================================
' Module    : BW_FormHelper, © Benny Wunder (2015)
' Version   : 1.1.0
' Type      : Class
' Author    : Benny Wunder, bw-services.net
' Date      : 2015|07|10
' Purpose   : The Class provides functionality to configure an form in Microsoft Access and interact with them.
'           : Especially the formatting of labels are provided by this class. The class works like a 'CSS' Script in HTML.
'           : The controls which should be formatted must be tagged with one of the following values:
'           :  * BWFH_H1 to configure the control with the setting of H1
'           :  * BWFH_H2 to configure the control with the setting of H2
'           :  * BWFH_H3 to configure the control with the setting of H3
'           :  * BWFH_Small to configure the control with the setting of small
'           :  * BWFH_Tiny to configure the control with the setting of tiny
'           :  * BWFH_Text to configure the control with the setting of text
'           : tagvalues are case insensitive!
'           : Further there is a possibility to validate mandatory fields and color them according to the setting which
'           : is given with EmptyFieldsBackColor and EmptyFieldsFontColor
' Licence   : This example is free to use and adopt it in your own solutions without changing the author information in the
'           : classheader.
'---------------------------------------------------------------------------------------------------------------------------
' Example   : Private m_FormHelper As BW_FormHelper
'
'             Private Sub Form_Load()
'             Set m_FormHelper = New BW_FormHelper
'
'               With m_FormHelper
'                  .Init Me
'                  .ConfigH1 "Calibri", 16, vbBlue
'                  .ConfigH2 "Arial Black", 14, vbWhite, vbBlack
'                  .ConfigH3 "Arial Black", 12, vbRed
'                  .ConfigText "Arial", 10
'                  .ConfigTiny "Arial", 6, vbMagenta
'                  .ConfigSmall "Tahoma", 8
'
'                  .EmptyFieldsBackColor = vbRed
'                  .EmptyFieldsFontColor = vbWhite
'
'                  .Config
 
'                  .MandatoryFields.Add Me!TextBox1
'                End With
'
'             End Sub
'===========================================================================================================================
'///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
 
 
'=== CONSTANTS / TYPES / EVENTS / ENUMS / PROPERTIES =======================================================================
Private Const AUTHOR As String = "Benny Wunder"
Private Const VERSION As String = "1.1.0"
 
 
Private Const DEFAULTBACKCOLOR As Long = vbWhite
Private Const DEFAULTFONTCOLOR As Long = vbBlack
 
Private Enum ErrNumbers
    noMandatoryFields = vbObjectError + 1024
End Enum
 
Private Type FontConfig
    isLoaded As Boolean
    fontColor As Long
    fontName As String
    fontSize As Long
    backColor As Long
End Type
 
Private m_ConfigH1 As FontConfig
Private m_ConfigH2 As FontConfig
Private m_ConfigH3 As FontConfig
Private m_ConfigSmall As FontConfig
Private m_ConfigTiny As FontConfig
Private m_ConfigText As FontConfig
 
Private m_FormObject As Object
Private m_MandatoryFields As Collection
Private m_EmptyFieldsBackColor As Long
Private m_EmptyFieldsFontColor As Long
 
 
Friend Property Set FormObject(ByRef frm As Object)
    Set m_FormObject = frm
End Property
 
Friend Property Get FormObject() As Object
    Set FormObject = m_FormObject
End Property
 
 
Friend Property Let EmptyFieldsBackColor(color As Long)
    m_EmptyFieldsBackColor = color
End Property
 
Friend Property Let EmptyFieldsFontColor(color As Long)
    m_EmptyFieldsFontColor = color
End Property
 
 
Friend Property Get MandatoryFields() As Collection
    Set MandatoryFields = m_MandatoryFields
End Property
 
 
 
Friend Sub ConfigH1(ByVal fontName As String, ByVal fontSize As Long, Optional ByVal fontColor As Long = DEFAULTFONTCOLOR, Optional ByVal backColor As Long = DEFAULTBACKCOLOR)
    With m_ConfigH1
        .isLoaded = True
        .fontName = fontName
        .fontSize = fontSize
        .fontColor = fontColor
        .backColor = backColor
    End With
End Sub
 
Friend Sub ConfigH2(ByVal fontName As String, ByVal fontSize As Long, Optional ByVal fontColor As Long = DEFAULTFONTCOLOR, Optional ByVal backColor As Long = DEFAULTBACKCOLOR)
    With m_ConfigH2
        .isLoaded = True
        .fontName = fontName
        .fontSize = fontSize
        .fontColor = fontColor
        .backColor = backColor
    End With
End Sub
 
Friend Sub ConfigH3(ByVal fontName As String, ByVal fontSize As Long, Optional ByVal fontColor As Long = DEFAULTFONTCOLOR, Optional ByVal backColor As Long = DEFAULTBACKCOLOR)
    With m_ConfigH3
        .isLoaded = True
        .fontName = fontName
        .fontSize = fontSize
        .fontColor = fontColor
        .backColor = backColor
    End With
End Sub
 
Friend Sub ConfigSmall(ByVal fontName As String, ByVal fontSize As Long, Optional ByVal fontColor As Long = DEFAULTFONTCOLOR, Optional ByVal backColor As Long = DEFAULTBACKCOLOR)
    With m_ConfigSmall
        .isLoaded = True
        .fontName = fontName
        .fontSize = fontSize
        .fontColor = fontColor
        .backColor = backColor
    End With
End Sub
 
Friend Sub ConfigTiny(ByVal fontName As String, ByVal fontSize As Long, Optional ByVal fontColor As Long = DEFAULTFONTCOLOR, Optional ByVal backColor As Long = DEFAULTBACKCOLOR)
    With m_ConfigTiny
        .isLoaded = True
        .fontName = fontName
        .fontSize = fontSize
        .fontColor = fontColor
        .backColor = backColor
    End With
End Sub
 
Friend Sub ConfigText(ByVal fontName As String, ByVal fontSize As Long, Optional ByVal fontColor As Long = DEFAULTFONTCOLOR, Optional ByVal backColor As Long = DEFAULTBACKCOLOR)
    With m_ConfigText
        .isLoaded = True
        .fontName = fontName
        .fontSize = fontSize
        .fontColor = fontColor
        .backColor = backColor
    End With
End Sub
 
 
 
'=== CONSTRUCTOR / DESTRUCTOR ==============================================================================================
Friend Sub Init(ByRef FormObject As Object)
    Set m_FormObject = FormObject
End Sub
 
Private Sub Class_Initialize()
    Set m_MandatoryFields = New Collection
End Sub
 
Private Sub Class_Terminate()
    On Error Resume Next
    Set m_FormObject = Nothing
    Set m_MandatoryFields = Nothing
    On Error GoTo 0
End Sub
 
 
 
'=== METHODS ===============================================================================================================
Friend Sub Config()
On Error GoTo Exit_Config
 
    ConfigFonts
 
Exit_Config:
    Select Case Err.number
        Case 0
        Case 424
            Err.Raise Err.number, Err.source & vbNewLine & vbTab & "BW_FormHelper.Config", "No FormObject initialized"
        Case Else
            Err.Raise Err.number, Err.source & vbNewLine & vbTab & "BW_FormHelper.Config", Err.description
    End Select
    GoSub CleanUp
    Exit Sub
 
CleanUp:
    Return
End Sub
 
 
Private Sub ConfigFonts()
On Error GoTo Exit_ConfigFonts
 
Dim ctl As Control
Dim FontConfig As FontConfig
Dim subFormHelper As BW_FormHelper
 
    For Each ctl In m_FormObject.Controls
        If (ctl.ControlType = acSubform) Then
            Set subFormHelper = New BW_FormHelper
            subFormHelper.Init ctl.Form
            subFormHelper.Config
        Else
            With ctl
 
                Select Case LCase(.Tag)
                    Case "", vbNullString, Null
                        FontConfig.isLoaded = False
                    Case "bwfh_h1"
                        FontConfig = m_ConfigH1
                    Case "bwfh_h2"
                        FontConfig = m_ConfigH2
                    Case "bwfh_h3"
                        FontConfig = m_ConfigH3
                    Case "bwfh_small"
                        FontConfig = m_ConfigSmall
                    Case "bwfh_tiny"
                        FontConfig = m_ConfigTiny
                    Case "bwfh_text"
                        FontConfig = m_ConfigText
                    Case Else
                        FontConfig.isLoaded = False
                End Select
 
                If FontConfig.isLoaded Then
                    .ForeColor = FontConfig.fontColor
                    .fontName = FontConfig.fontName
                    .fontSize = FontConfig.fontSize
                    If FontConfig.backColor <> vbWhite Then
                        .BackStyle = 1
                    End If
                    .backColor = FontConfig.backColor
                End If
 
            End With
        End If
    Next ctl
 
Exit_ConfigFonts:
    Select Case Err.number
        Case 0
        Case 2101
            Err.Raise Err.number, Err.source & vbNewLine & vbTab & "BW_FormHelper.ConfigFonts", "Value for config not valid. Please check your configuration for controls with tag '" & ctl.Tag & "'"
        Case Else
            Err.Raise Err.number, Err.source & vbNewLine & vbTab & "BW_FormHelper.ConfigFonts", Err.description
    End Select
    GoSub CleanUp
    Exit Sub
 
CleanUp:
    Set subFormHelper = Nothing
    Return
End Sub
 
 
Friend Function FieldIsEmpty(Optional ctl As Control) As Boolean
On Error GoTo Exit_FieldIsEmpty
 
Dim result As Boolean
 
    If (ctl Is Nothing) Then Set ctl = Screen.ActiveControl
 
    On Error Resume Next
    With ctl
        result = (IsNull(m_FormObject.Controls(.Name).value) Or (m_FormObject.Controls(.Name).value = vbNullString))
        If (result And m_EmptyFieldsBackColor <> 0) Then
            .backColor = m_EmptyFieldsBackColor
            .ForeColor = m_EmptyFieldsFontColor
        Else
            .backColor = vbWhite
            .ForeColor = vbBlack
        End If
    End With
    On Error GoTo 0
 
Exit_FieldIsEmpty:
    Select Case Err.number
        Case 0
        Case Else
            Err.Raise Err.number, Err.source & vbNewLine & vbTab & "BW_FormHelper.FieldIsEmpty", Err.description
    End Select
    GoSub CleanUp
    Exit Function
 
CleanUp:
    FieldIsEmpty = result
    Return
 
End Function
 
 
Friend Sub ValidateMandatoryFields(Optional ByRef mandatoryFieldsNotFilled As Boolean)
On Error GoTo Exit_ValidateMandatoryFields
 
Dim ctl As Object
 
    If m_MandatoryFields.Count > 0 Then
        For Each ctl In m_MandatoryFields
            mandatoryFieldsNotFilled = (mandatoryFieldsNotFilled + FieldIsEmpty(ctl))
        Next ctl
    Else
        Err.Raise ErrNumbers.noMandatoryFields, "ValidateMandatoryFields", "No mandatory fields are set!"
    End If
 
Exit_ValidateMandatoryFields:
    Select Case Err.number
        Case 0
        Case Else
            Err.Raise Err.number, Err.source & vbNewLine & vbTab & "BW_FormHelper.ValidateMandatoryFields", Err.description
    End Select
    GoSub CleanUp
    Exit Sub
 
CleanUp:
    Return
 
End Sub