399 lines
10 KiB
QBasic
399 lines
10 KiB
QBasic
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
|
|
|