Option Compare Database
Option Explicit

Function SetDataPath()

'SetLinkTablePath "", GetParameter("DATAPATH") + "WGDATEN.ACCDB"
'SetLinkTablePath "", "D:\PROJEKT\CHRIS\WGMASTER\WGDATEN.ACCDB"

End Function


Function SetFormProperty(FormName As String, PropertyName As String, PropertyValue As Variant)
'Set Form Property, if Formname="" then set Property of all Forms

If FormName = "" Or IsNull(FormName) Then
 Dim db1 As Database
 Dim cnt1 As Container
 Dim doc1 As Document

 Set db1 = CurrentDb
  For Each cnt1 In db1.Containers
   If cnt1.Name = "Forms" Then
    For Each doc1 In cnt1.Documents
     DoCmd.OpenForm doc1.Name, acDesign
     On Error Resume Next
     Forms(doc1.Name).Properties(PropertyName) = PropertyValue
     DoCmd.Save
     DoCmd.Close
    Next doc1
   End If
 Next cnt1

Else
 DoCmd.OpenForm FormName, acDesign
 Forms(FormName).Properties(PropertyName) = PropertyValue
 DoCmd.Save
 DoCmd.Close
End If

End Function

Function GetFormProperty(FormName As String, PropertyName As String) As Variant
'Read Form Property

DoCmd.OpenForm FormName, acDesign
GetFormProperty = Forms(FormName).Properties(PropertyName)
DoCmd.Close

End Function

Function SetFormControlProperty(FormName As String, ControlName As String, Controltype As Integer, PropertyName As String, PropertyValue As Variant)
' Sets the given property of the given control in the given form to the given value
' If Formname="" then all forms
' If Controlname="" then all controls

Dim sec1 As Section
Dim ctl1 As Control
Dim i As Integer

If FormName = "" Or IsNull(FormName) Then

 Dim db1 As Database
 Dim cnt1 As Container
 Dim doc1 As Document

 Set db1 = CurrentDb
  For Each cnt1 In db1.Containers
   If cnt1.Name = "Forms" Then
    For Each doc1 In cnt1.Documents
     DoCmd.OpenForm doc1.Name, acDesign
     'Search all Sections for desired Control
     For i = 0 To 4
      On Error Resume Next
      Set sec1 = Forms(doc1.Name).Section(i)
      For Each ctl1 In sec1.Controls
       If ctl1.Name = ControlName Or ControlName = "" Or IsNull(ControlName) Then
        'Has the desired control this property ?
        If Controltype = ctl1.Controltype Or Controltype = -1 Then
         On Error Resume Next
         ctl1.Properties(PropertyName) = PropertyValue
        End If
       End If
      Next ctl1
     Next i
     DoCmd.Save
     DoCmd.Close
    Next doc1
   End If
 Next cnt1

Else
 DoCmd.OpenForm FormName, acDesign
 For i = 0 To 4
  Set sec1 = Forms(FormName).Section(i)
  For Each ctl1 In sec1.Controls
   If ctl1.Name = ControlName Or ControlName = "" Or IsNull(ControlName) Then
    On Error Resume Next
    ctl1.Properties(PropertyName) = PropertyValue
   End If
  Next ctl1
 Next i
 DoCmd.Save
 DoCmd.Close
End If

End Function

Function SetFormSectionProperty(FormName As String, SectionName As String, PropertyName As String, PropertyValue As Variant)
' Sets the given property of the given section in the given form to the given value
' If Formname="" then all forms
' If Sectionname="" then all sections

Dim sec1 As Section
Dim ctl1 As Control
Dim i As Integer

If FormName = "" Or IsNull(FormName) Then

 Dim db1 As Database
 Dim cnt1 As Container
 Dim doc1 As Document

 Set db1 = CurrentDb
  For Each cnt1 In db1.Containers
   If cnt1.Name = "Forms" Then
    For Each doc1 In cnt1.Documents
     DoCmd.OpenForm doc1.Name, acDesign
     'Search all Sections for desired Control
     For i = 0 To 4
      On Error Resume Next
       Set sec1 = Forms(doc1.Name).Section(i)
       If SectionName = sec1.Name Or SectionName = "" Or IsNull(SectionName) Then
        sec1.Properties(PropertyName) = PropertyValue
       End If
     Next i
     DoCmd.Save
     DoCmd.Close
    Next doc1
   End If
 Next cnt1

Else
 DoCmd.OpenForm FormName, acDesign
 For i = 0 To 4
  Set sec1 = Forms(FormName).Section(i)
  If SectionName = sec1.Name Or SectionName = "" Or IsNull(SectionName) Then
   On Error Resume Next
   sec1.Properties(PropertyName) = PropertyValue
  End If
 Next i
 DoCmd.Save
 DoCmd.Close
End If

End Function

Function GetFormControlProperty(FormName As String, ControlName As String, PropertyName As String) As Variant

Dim sec1 As Section
Dim ctl1 As Control
Dim i As Integer

'Search all Sections for desired Control

DoCmd.OpenForm FormName, acDesign
For i = 0 To 4
 Set sec1 = Forms(FormName).Section(i)
 For Each ctl1 In sec1.Controls
  If ctl1.Name = ControlName Then
   GetFormControlProperty = ctl1.Properties(PropertyName)
   i = 9
   Exit For
  End If
 Next ctl1
Next i
DoCmd.Close

End Function


Function SetReportProperty(reportname As String, PropertyName As String, PropertyValue As Variant)
'Set Report Property, if Report Name="" then all Reports

If reportname = "" Or IsNull(reportname) Then
 Dim db1 As Database
 Dim cnt1 As Container
 Dim doc1 As Document

 Set db1 = CurrentDb
  For Each cnt1 In db1.Containers
   If cnt1.Name = "Reports" Then
    For Each doc1 In cnt1.Documents
     DoCmd.OpenReport doc1.Name, acDesign
     On Error Resume Next
     Reports(doc1.Name).Properties(PropertyName) = PropertyValue
     DoCmd.Save
     DoCmd.Close
    Next doc1
   End If
 Next cnt1
Else
 DoCmd.OpenReport reportname, acViewDesign
 Reports(reportname).Properties(PropertyName) = PropertyValue
 DoCmd.Save
 DoCmd.Close
End If

End Function


Function GetReportProperty(reportname As String, PropertyName As String) As Variant
'Read Form Property

DoCmd.OpenReport reportname, acViewDesign
GetReportProperty = Reports(reportname).Properties(PropertyName)
DoCmd.Close

End Function

Function SetReportControlProperty(reportname As String, ControlName As String, Controltype As Integer, PropertyName As String, PropertyValue As Variant)
' Sets the given property of the given control in the given form to the given value
' If Formname="" then all forms
' If Controlname="" then all controls

Dim sec1 As Section
Dim ctl1 As Control
Dim i As Integer

If reportname = "" Or IsNull(reportname) Then
'All Reports
 Dim db1 As Database
 Dim cnt1 As Container
 Dim doc1 As Document

 Set db1 = CurrentDb
  For Each cnt1 In db1.Containers
   If cnt1.Name = "Reports" Then
    For Each doc1 In cnt1.Documents
     DoCmd.OpenReport doc1.Name, acViewDesign
     'Search all Sections for desired Control
     For i = 0 To 8
      Set sec1 = Reports(doc1.Name).Section(i)
      For Each ctl1 In sec1.Controls
       If ctl1.Name = ControlName Or ControlName = "" Or IsNull(ControlName) Then
        If Controltype = ctl1.Controltype Or Controltype = -1 Then
         On Error Resume Next
         ctl1.Properties(PropertyName) = PropertyValue
        End If
       End If
      Next ctl1
     Next i
     DoCmd.Save
     DoCmd.Close
    Next doc1
   End If
 Next cnt1

Else
 DoCmd.OpenReport reportname, acViewDesign
 For i = 0 To 8
  Set sec1 = Reports(reportname).Section(i)
  For Each ctl1 In sec1.Controls
   If ctl1.Name = ControlName Or ControlName = "" Or IsNull(ControlName) Then
    On Error Resume Next
    ctl1.Properties(PropertyName) = PropertyValue
   End If
  Next ctl1
 Next i
 DoCmd.Save
 DoCmd.Close
End If

End Function

Function GetReportControlProperty(reportname As String, ControlName As String, PropertyName As String) As Variant

Dim sec1 As Section
Dim ctl1 As Control
Dim i As Integer

'Search all Sections for desired Control

DoCmd.OpenReport reportname, acDesign
For i = 0 To 4
 Set sec1 = Reports(reportname).Section(i)
 For Each ctl1 In sec1.Controls
  If ctl1.Name = ControlName Then
   On Error Resume Next
   GetReportControlProperty = ctl1.Properties(PropertyName)
   i = 9
   Exit For
  End If
 Next ctl1
Next i
DoCmd.Close

End Function

Function SetReportSectionProperty(reportname As String, SectionName As String, PropertyName As String, PropertyValue As Variant)
' Sets the given property of the given control in the given form to the given value
' If Formname="" then all forms
' If Controlname="" then all controls

Dim sec1 As Section
Dim ctl1 As Control
Dim i As Integer

If reportname = "" Or IsNull(reportname) Then
'All Reports
 Dim db1 As Database
 Dim cnt1 As Container
 Dim doc1 As Document

 Set db1 = CurrentDb
  For Each cnt1 In db1.Containers
   If cnt1.Name = "Reports" Then
    For Each doc1 In cnt1.Documents
     DoCmd.OpenReport doc1.Name, acViewDesign
     'Search all Sections for desired Control
     For i = 0 To 8
      On Error Resume Next
      Set sec1 = Reports(doc1.Name).Section(i)
      If SectionName = sec1.Name Or SectionName = "" Or IsNull(SectionName) Then
       On Error Resume Next
       sec1.Properties(PropertyName) = PropertyValue
      End If
     Next i
     DoCmd.Save
     DoCmd.Close
    Next doc1
   End If
 Next cnt1

Else
 DoCmd.OpenReport reportname, acViewDesign
 For i = 0 To 8
  Set sec1 = Reports(reportname).Section(i)
   If SectionName = sec1.Name Or SectionName = "" Or IsNull(SectionName) Then
    On Error Resume Next
    sec1.Properties(PropertyName) = PropertyValue
   End If
 Next i
 DoCmd.Save
 DoCmd.Close
End If

End Function


Function SetLinkTablePath(TableName As String, path1 As String)
'Set Table Property, if Tablename="" then set Property of all Tables
 Dim db1 As Database
 Dim tdf1 As TableDef
 Set db1 = CurrentDb

 For Each tdf1 In db1.TableDefs
  If TableName = tdf1.Name Or TableName = "" Or IsNull(TableName) Then
    If (Left(tdf1.Name, 1) = "T" And TableName = "") Or TableName <> "" Then
     tdf1.connect = ";DATABASE=" + path1
     On Error Resume Next
     tdf1.RefreshLink
    End If
  End If
 Next tdf1

End Function


' Example for easy usage : set form backgroundcolors

Function SetBackGroundColor_AllForms(r As Long, g As Long, b As Long)
 
SetFormSectionProperty "", "", "Backcolor", RGB(r, g, b)
'SetFormControlProperty "", "", -1, "Backcolor", RGB(r, g, b)
'SetFormControlProperty "", "", acTextBox, "Backcolor", RGB(255, 255, 255)
'SetFormControlProperty "", "", acComboBox, "Backcolor", RGB(255, 255, 255)
'SetFormControlProperty "", "", acListBox, "Backcolor", RGB(255, 255, 255)

End Function

Sub test()

'SetBackGroundColor_AllForms &HEE, &HFF, &HEE
'SetFormControlProperty "", "", acTextBox, "FontSize", 9
SetFormControlProperty "", "", acComboBox, "FontSize", 9

End Sub



Function SetDefaultDataPath()


 SetLinkTablePath "", GetAppPath + "WGLEER.ACCDB"
 SetLinkTablePath "Mandanten", GetAppPath + "WGMANDNT.ACCDB"

End Function