Exported VBA
This commit is contained in:
328
wgmaster/vba/Form_MAdministration.frm
Normal file
328
wgmaster/vba/Form_MAdministration.frm
Normal file
@ -0,0 +1,328 @@
|
||||
Option Compare Database
|
||||
Option Explicit
|
||||
|
||||
Private Sub Befehl14_Click()
|
||||
|
||||
Dim filename As String
|
||||
Dim defaultfilename As String
|
||||
Dim str1
|
||||
|
||||
If IsNull(GetParameter("UPDATEPATH")) Then
|
||||
SetParameter "UPDATEPATH", "A:\WGUPDATE.ACCDB"
|
||||
End If
|
||||
|
||||
defaultfilename = GetParameter("UPDATEPATH")
|
||||
|
||||
'defaultfilename = "D:\PROJEKT\CHRIS\WGMASTER\WGUPDATE.ACCDB"
|
||||
|
||||
filename = InputBox("Geben Sie Bitte den Dateinamen ein: ", "Update einspielen", defaultfilename)
|
||||
|
||||
If Not IsNull(filename) And filename <> "" Then
|
||||
|
||||
SetParameter "UPDATEPATH", filename
|
||||
|
||||
Dim db1 As Database
|
||||
Dim cnt1 As Container
|
||||
Dim doc1 As Document
|
||||
|
||||
' Current Database for SQL Statements
|
||||
Dim db2 As Database
|
||||
Dim rs1 As Recordset
|
||||
|
||||
|
||||
Set db2 = Application.DBEngine.Workspaces(0).OpenDatabase(GetDataPath())
|
||||
|
||||
On Error GoTo err1
|
||||
Set db1 = Application.DBEngine.Workspaces(0).OpenDatabase(filename)
|
||||
On Error GoTo 0
|
||||
For Each cnt1 In db1.Containers
|
||||
If cnt1.Name = "Forms" Then
|
||||
For Each doc1 In cnt1.Documents
|
||||
If MsgBox(doc1.Name + " importieren ?", vbYesNo) = vbYes Then
|
||||
On Error Resume Next
|
||||
'close open forms
|
||||
If Not IsNull(Form(doc1.Name)) Then
|
||||
DoCmd.Close acForm, doc1.Name
|
||||
End If
|
||||
|
||||
DoCmd.DeleteObject acForm, doc1.Name
|
||||
DoCmd.TransferDatabase acImport, "Microsoft Access", filename, acForm, doc1.Name, doc1.Name
|
||||
End If
|
||||
Next doc1
|
||||
End If
|
||||
If cnt1.Name = "Reports" Then
|
||||
For Each doc1 In cnt1.Documents
|
||||
If MsgBox(doc1.Name + " importieren ?", vbYesNo) = vbYes Then
|
||||
On Error Resume Next
|
||||
DoCmd.DeleteObject acReport, doc1.Name
|
||||
DoCmd.TransferDatabase acImport, "Microsoft Access", filename, acReport, doc1.Name, doc1.Name
|
||||
End If
|
||||
Next doc1
|
||||
End If
|
||||
|
||||
If cnt1.Name = "Tables" Then
|
||||
For Each doc1 In cnt1.Documents
|
||||
If doc1.Name = "Update_SQLStatements" Then
|
||||
Set rs1 = db1.OpenRecordset("Update_SQLStatements")
|
||||
While Not rs1.EOF
|
||||
If MsgBox(rs1!Beschreibung + " ?", vbYesNo) = vbYes Then
|
||||
db2.Execute (rs1!SQLStatement)
|
||||
End If
|
||||
rs1.MoveNext
|
||||
Wend
|
||||
rs1.Close
|
||||
End If
|
||||
Next doc1
|
||||
End If
|
||||
|
||||
If cnt1.Name = "Modules" Then
|
||||
For Each doc1 In cnt1.Documents
|
||||
If MsgBox(doc1.Name + " importieren ?", vbYesNo) = vbYes Then
|
||||
On Error Resume Next
|
||||
DoCmd.DeleteObject acModule, doc1.Name
|
||||
DoCmd.TransferDatabase acImport, "Microsoft Access", filename, acModule, doc1.Name, doc1.Name
|
||||
End If
|
||||
Next doc1
|
||||
End If
|
||||
|
||||
|
||||
Next cnt1
|
||||
|
||||
End If
|
||||
|
||||
Exit Sub
|
||||
|
||||
err1:
|
||||
|
||||
MsgBox "FEHLER: Update-Datei nicht gefunden !", vbCritical
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub Befehl15_Click()
|
||||
|
||||
DoCmd.OpenForm "MImport"
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub Befehl16_Click()
|
||||
|
||||
DoCmd.OpenForm "MExport"
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
Private Sub BLogoAkt_Click()
|
||||
|
||||
Dim datapath As String
|
||||
Dim Data As String
|
||||
|
||||
Data = DMax("[Data]", "Mandanten", "MANR=" + Format(Forms!MMandantenauswahl!LMandanten))
|
||||
datapath = GetPathWithoutFilename(Data)
|
||||
If FileSystem.FileLen(datapath + "LOGO.BMP") > 0 Then
|
||||
SetReportControlProperty1 "", "BLogo", acImage, "Picture", datapath + "LOGO.BMP"
|
||||
End If
|
||||
|
||||
End Sub
|
||||
|
||||
Function SetReportControlProperty1(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 Variant
|
||||
|
||||
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
|
||||
If doc1.Name <> "BAuszahlungsvariante" Then
|
||||
DoCmd.OpenReport doc1.Name, acViewDesign
|
||||
|
||||
On Error Resume Next
|
||||
'look into all sections
|
||||
For i = 0 To 8
|
||||
'If Reports(doc1.Name).Section(i).Visible = True Then
|
||||
Reports(doc1.Name).Controls(ControlName).Properties(PropertyName) = PropertyValue
|
||||
'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
|
||||
'End If
|
||||
Next i
|
||||
DoCmd.Save
|
||||
DoCmd.Close
|
||||
End If
|
||||
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
|
||||
|
||||
Private Sub BOk_Click()
|
||||
|
||||
If LWaagentyp <> "L246" Then
|
||||
DoCmd.OpenForm "FÜbernahme", acDesign
|
||||
Forms!FÜbernahme!XComm.Settings = TSettings
|
||||
Forms!FÜbernahme!XComm.CommPort = LPort
|
||||
Forms!FÜbernahme!XCommSteuerung.CommPort = LPortSteuerung
|
||||
DoCmd.Save
|
||||
DoCmd.Close
|
||||
End If
|
||||
|
||||
SetParameter "WAAGENTYP", LWaagentyp
|
||||
SetParameter "STEUERUNGTYP", LSteuerungtyp
|
||||
SetParameter "WAAGEPORT", LPort
|
||||
SetParameter "STEUERUNGPORT", LPortSteuerung
|
||||
SetParameter "WAAGEPORTSETTINGS", TSettings
|
||||
|
||||
|
||||
SetParameter "WAAGENMONITORLIMIT", TWaagenmonitorLimit
|
||||
|
||||
If OWaagenmonitor Then
|
||||
SetParameter "WAAGENMONITOR", "1"
|
||||
Else
|
||||
SetParameter "WAAGENMONITOR", "0"
|
||||
End If
|
||||
|
||||
|
||||
DoCmd.Close
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Close()
|
||||
|
||||
SetParameter "WAAGENTYP", LWaagentyp
|
||||
|
||||
If LSteuerungtyp = "PARALLEL" Then
|
||||
SetParameter "STEUERUNGPORT", LLPT
|
||||
End If
|
||||
|
||||
If LSteuerungtyp = "SERIELL" Then
|
||||
SetParameter "STEUERUNGPORT", LPortSteuerung
|
||||
End If
|
||||
|
||||
If LSteuerungtyp = "EXTERN" Then
|
||||
SetParameter "STEUERUNGEXTERN", TExtern
|
||||
End If
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub Form_Open(Cancel As Integer)
|
||||
|
||||
|
||||
'DoCmd.OpenForm "FÜbernahme", acDesign
|
||||
|
||||
'TSettings = Forms!FÜbernahme!XComm.Settings
|
||||
'LPort = Forms!FÜbernahme!XComm.CommPort
|
||||
'LPortSteuerung = Forms!FÜbernahme!XCommSteuerung.CommPort
|
||||
TSettings = GetParameter("WAAGEPORTSETTINGS")
|
||||
LPort = GetParameter("WAAGEPORT")
|
||||
LPortSteuerung = GetParameter("STEUERUNGPORT")
|
||||
|
||||
'DoCmd.Save
|
||||
'DoCmd.Close
|
||||
|
||||
LWaagentyp = GetParameter("WAAGENTYP")
|
||||
LSteuerungtyp = GetParameter("STEUERUNGTYP")
|
||||
|
||||
Dim host As String
|
||||
Dim tcpport As Long
|
||||
|
||||
If IsNull(GetParameter("WAAGEHOST")) Then
|
||||
SetParameter "WAAGEHOST", "10.0.0.80"
|
||||
SetParameter "WAAGETCPPORT", "1234"
|
||||
End If
|
||||
|
||||
host = GetParameter("WAAGEHOST")
|
||||
tcpport = GetParameter("WAAGETCPPORT")
|
||||
|
||||
|
||||
|
||||
If LSteuerungtyp = "SERIELL" Then
|
||||
LPortSteuerung.Visible = True
|
||||
XPortSteuerung.Visible = True
|
||||
LPortSteuerung = GetParameter("STEUERUNGPORT")
|
||||
Else
|
||||
LPortSteuerung.Visible = False
|
||||
XPortSteuerung.Visible = False
|
||||
End If
|
||||
|
||||
If LSteuerungtyp = "PARALLEL" Then
|
||||
LLPT.Visible = True
|
||||
XLPT.Visible = True
|
||||
LLPT = GetParameter("STEUERUNGPORT")
|
||||
Else
|
||||
LLPT.Visible = False
|
||||
XLPT.Visible = False
|
||||
End If
|
||||
|
||||
If LSteuerungtyp = "EXTERN" Then
|
||||
TExtern.Visible = True
|
||||
TExtern = GetParameter("STEUERUNGEXTERN")
|
||||
Else
|
||||
TExtern.Visible = False
|
||||
End If
|
||||
|
||||
TWaagenmonitorLimit = GetParameter("WAAGENMONITORLIMIT")
|
||||
If GetParameter("WAAGENMONITOR") = "1" Then
|
||||
OWaagenmonitor = True
|
||||
Else
|
||||
OWaagenmonitor = False
|
||||
End If
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub LSteuerungtyp_Click()
|
||||
|
||||
If LSteuerungtyp = "SERIELL" Then
|
||||
LPortSteuerung.Visible = True
|
||||
XPortSteuerung.Visible = True
|
||||
Else
|
||||
LPortSteuerung.Visible = False
|
||||
XPortSteuerung.Visible = False
|
||||
End If
|
||||
|
||||
If LSteuerungtyp = "PARALLEL" Then
|
||||
LLPT.Visible = True
|
||||
XLPT.Visible = True
|
||||
Else
|
||||
LLPT.Visible = False
|
||||
XLPT.Visible = False
|
||||
End If
|
||||
|
||||
If LSteuerungtyp = "EXTERN" Then
|
||||
TExtern.Visible = True
|
||||
Else
|
||||
TExtern.Visible = False
|
||||
End If
|
||||
|
||||
End Sub
|
||||
Reference in New Issue
Block a user