Exported VBA
This commit is contained in:
398
wgmaster/vba/MProperties.bas
Normal file
398
wgmaster/vba/MProperties.bas
Normal file
@ -0,0 +1,398 @@
|
||||
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
|
||||
|
||||
Reference in New Issue
Block a user