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
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
 
End Sub
 
 
Private Sub ConfigFonts()
 
   Dim ctl           As Control
   Dim FontConfig    As FontConfig
   Dim subFormHelper As BW_FormHelper
 
   On Error GoTo Exit_ConfigFonts
 
   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
 
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
 
End Sub
 
 
Friend Function FieldIsEmpty(Optional ctl As Control) As Boolean
 
Dim result As Boolean
 
   On Error GoTo Exit_FieldIsEmpty
   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
 
End Function
 
 
Friend Sub ValidateMandatoryFields(Optional ByRef mandatoryFieldsNotFilled As Boolean)
 
   Dim ctl As Object
 
   On Error GoTo Exit_ValidateMandatoryFields
   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
 
End Sub