328 lines
7.6 KiB
Plaintext
328 lines
7.6 KiB
Plaintext
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 |