von Buddy0815 » Di, 01.11.2011 13:35
Hallo,
die Daten werden folgendermaßen in die Datenbank geschrieben:
Code: Alles auswählen
Query = "INSERT INTO ..."
Statement.executeUpdate(Query)
Die Makros laufen ja auch ohne Fehler durch.
in 2 von 8 Fällen sind die Daten jedoch beim nächsten Starten des Rechners weg.
Hier mal der komplette Code eines Makros:
Code: Alles auswählen
REM ***** Neuen Schiesstag anlegen *****
Dim DatabaseContext As Object
Dim DataSource As Object
Dim Connection As Object
Dim InteractionHandler as Object
Dim Statement As Object
Dim ResultSet As Object
Dim Query As String
Dim oDialog1 As Object
Dim oPBListener1
Dim oPBListener2
Dim Class() As String
Dim Saison As Integer
Dim Schiesstag As Integer
Dim Fleisch As Boolean
Dim Fontsize As Integer
Dim Font As String
Sub Neuer_Schiesstag
Dim Datum_string As String
Dim Class_Fleisch As Integer
DatabaseContext = createUnoService("com.sun.star.sdb.DatabaseContext")
DataSource = DatabaseContext.getByName("Datenbank")
If Not DataSource.IsPasswordRequired Then
Connection = DataSource.GetConnection("","")
Else
InteractionHandler = createUnoService("com.sun.star.sdb.InteractionHandler")
Connection = DataSource.ConnectWithCompletion(InteractionHandler)
End If
Statement = Connection.createStatement()
Statement.setPropertyValue("ResultSetType",1004)
REM ***** Schrift initialisieren
Font = "Arial"
Fontsize = 10
REM ***** Aktuelle Saison auslesen *****
Query = "SELECT * FROM ""Saison"" WHERE ""Aktiv"" = 'True'"
ResultSet = Statement.executeQuery(Query)
If Not IsNull(ResultSet) Then
If Not ResultSet.Next Then
REM ***** Keine aktive Saison gefunden
MsgBox "Keine aktive Saison gefunden!", MB_ICONSTOP, "Fehler"
Else
REM ***** Aktuelle Saison speichern
Saison = ResultSet.getInt(1)
If ResultSet.getString(2) = "" Then
Rem ***** Erster Schiesstag in Saison
Schiesstag = 1
Fleisch = True
End If
REM ***** Überprüfe ob für heutiges Datum bereits ein Schiesstag begonnen wurde *****
Query = "SELECT ""Schiesstag"" FROM ""Schiesstage"" WHERE ""Schiesstage"".""Datum"" = CURRENT_DATE"
ResultSet = Statement.executeQuery(Query)
ResultSet.last()
If ResultSet.getRow() > 0 Then
MsgBox "Für das heutige Datum wurde bereits ein Schiesstag begonnen!", MB_ICONSTOP, "Fehler"
Else
REM ***** Suche nach letzten Schiesstag in aktueller Saison
Query = "SELECT MAX(""Schiesstag"") FROM ""Schiesstage"" WHERE ""Saison"" = "& Saison &""
ResultSet = Statement.executeQuery(Query)
If Not IsNull(ResultSet) Then
While ResultSet.next
' MsgBox ResultSet.getString(1)
REM ***** Erhöhe gefundenen Schiesstag in aktueller Saison
Schiesstag = ResultSet.getInt(1) + 1
REM ***** Wurde am letzten Schiesstag Fleisch geschossen?
Query = "SELECT ""Fleisch"" FROM ""Schiesstage"" WHERE ""Schiesstag"" = "& ResultSet.getInt(1) &" AND ""Saison"" = "& Saison &""
ResultSet = Statement.executeQuery(Query)
If Not IsNull(ResultSet) Then
If ResultSet.next Then
REM *** Setze Fleisch für aktuellen Schiesstag
Fleisch = ResultSet.getInt(1)
Fleisch = Not Fleisch
End If
End If
Wend
End If
Query = "SELECT * FROM ""Fleischpreise_Anzahl"""
ResultSet = Statement.executeQuery(Query)
ResultSet.last()
Dim iCounter As Integer
iCounter = ResultSet.getrow()
ReDim Class(iCounter - 1,1)
Class_Fleisch = 0
For i = 1 to iCounter
REM ***** Speichere Klassen in Array
ResultSet.absolute(i)
Class(i - 1,0) = ResultSet.getString(1)
Class(i - 1,1) = ResultSet.getInt(2)
REM ***** Zähle Anzahl Klassen mit Fleisch
If Fleisch And ResultSet.getInt(2) > 0 Then
Class_Fleisch = Class_Fleisch + 1
End If
Next i
REM ***** Es gibt keine Klassen mehr die Fleisch schiessen
If Fleisch AND Class_Fleisch = 0 Then
Fleisch = False
End If
REM ***** Dialog aufrufen
Call Dialog_Neuer_Schiesstag
End If
End If
End If
REM ***** Schliesse Verbindungen *****
Statement.close()
Connection.close()
End Sub
REM ***** Dialog für neuen Schiesstag
Sub Dialog_Neuer_Schiesstag
Dim oDialogModel As Object
Dim oWindow As Object
Dim oMod As Object
Dim oEvent1
Dim oEvent2
Dim i As Integer
REM ***** Initialisierung der Eigenschaften des Dialogs
oDialogModel = CreateUnoService("com.sun.star.awt.UnoControlDialogModel")
With oDialogModel
.setPropertyValue("PositionX", 50)
.setPropertyValue("PositionY", 50 )
.setPropertyValue("FontName", Font)
.setPropertyValue("FontHeight", Fontsize)
.setPropertyValue("Width", 150)
.setPropertyValue("Height", (Fontsize + 23) * (UBOUND(Class())+ 1))
.setPropertyValue("Title", "Neuen Schiesstag beginnen")
' .setPropertyValue("HelpText", "Wird Fleisch geschossen?")
End With
oDialog1 = CreateUnoService("com.sun.star.awt.UnoControlDialog")
REM ***** Textlabel erzeugen
oMod = oDialogModel.createInstance("com.sun.star.awt.UnoControlFixedTextModel")
With oMod
.setPropertyValue("Label", "Schiesstag: " & Schiesstag)
.setPropertyValue("Name", "LabelSD")
.setPropertyValue("PositionX", 10)
.setPropertyValue("PositionY", Fontsize)
.setPropertyValue("FontName", Font)
.setPropertyValue("FontHeight", Fontsize)
.setPropertyValue("Height", Fontsize + 2)
.setPropertyValue("Width", 80)
.setPropertyValue("HelpText", "Aktueller Schiesstag")
End With
oDialogModel.insertByName("LabelSD", oMod)
REM ***** Textlabel erzeugen
oMod = oDialogModel.createInstance("com.sun.star.awt.UnoControlFixedTextModel")
With oMod
.setPropertyValue("Label", Format(Date, "DD.MM.YYYY"))
.setPropertyValue("Name", "LabelDate")
.setPropertyValue("PositionX", 90)
.setPropertyValue("PositionY", Fontsize)
.setPropertyValue("Align", 2)
.setPropertyValue("FontName", Font)
.setPropertyValue("FontHeight", Fontsize)
.setPropertyValue("Height", Fontsize + 2)
.setPropertyValue("Width", 50)
.setPropertyValue("HelpText", "Datum")
End With
oDialogModel.insertByName("LabelDate", oMod)
REM ***** Linie erzeugen
oMod = oDialogModel.createInstance("com.sun.star.awt.UnoControlFixedLineModel")
With oMod
.setPropertyValue("Name", "FixedLabel")
.setPropertyValue("PositionX", 10)
.setPropertyValue("PositionY", Fontsize * 2)
.setPropertyValue("Height", 5)
.setPropertyValue("Width", 130)
End With
oDialogModel.insertByName("FixedLabel", oMod)
For i = 1 to UBOUND(Class()) + 1
REM ***** Textlabel erzeugen
oMod = oDialogModel.createInstance("com.sun.star.awt.UnoControlFixedTextModel")
With oMod
.setPropertyValue("Label", "Klasse " & Class(i-1,0) & ":")
.setPropertyValue("Name", "Label" & i + 1)
.setPropertyValue("PositionX", 30)
.setPropertyValue("PositionY", (Fontsize * 2) + (i * (Fontsize + 5)))
.setPropertyValue("Align", 2)
.setPropertyValue("FontName", Font)
.setPropertyValue("FontHeight", Fontsize)
.setPropertyValue("Height", Fontsize + 2)
.setPropertyValue("Width", 40)
End With
oDialogModel.insertByName("Label" & i, oMod)
REM ***** Checkboxen erzeugen
oMod = oDialogModel.createInstance("com.sun.star.awt.UnoControlCheckBoxModel")
With oMod
.setPropertyValue("Label", " ~Fleisch ("& Class(i-1,1) &")")
.setPropertyValue("Name", Class(i-1,0))
.setPropertyValue("PositionX", 75)
.setPropertyValue("PositionY", (Fontsize * 2) + (i * (Fontsize + 5)))
.setPropertyValue("Align", 0)
.setPropertyValue("VerticalAlign", 0)
.setPropertyValue("FontName", Font)
.setPropertyValue("FontHeight", Fontsize)
.setPropertyValue("Height", Fontsize + 2)
.setPropertyValue("Width", 55)
'REM ***** Initialisiere Checkboxen
If Fleisch AND Class(i-1,1) > 0 Then
.setPropertyValue("State", 1)
Else
.setPropertyValue("State", 0)
End If
If Class(i-1,1) = 0 Then
.setPropertyValue("Enabled", False)
End If
End With
oDialogModel.insertByName(Class(i-1,0), oMod)
Next i
REM ***** Pushbutton erzeugen
oMod = oDialogModel.createInstance("com.sun.star.awt.UnoControlButtonModel")
With oMod
.setPropertyValue("Label", "Weiter")
.setPropertyValue("Name", "PB1")
.setPropertyValue("PositionX", 35)
.setPropertyValue("PositionY", oDialogModel.Height - 30)
.setPropertyValue("FontName", Font)
.setPropertyValue("FontHeight", Fontsize)
.setPropertyValue("Height", Fontsize + 7)
.setPropertyValue("Width", 2 * Fontsize + 20)
End With
oDialogModel.insertByName("PB1", oMod)
REM ***** Pushbutton erzeugen
oMod = oDialogModel.createInstance("com.sun.star.awt.UnoControlButtonModel")
With oMod
.setPropertyValue("Label", "Abbruch")
.setPropertyValue("Name", "PB2")
.setPropertyValue("PositionX", 80)
.setPropertyValue("PositionY", oDialogModel.Height - 30)
.setPropertyValue("FontName", Font)
.setPropertyValue("FontHeight", Fontsize)
.setPropertyValue("Height", Fontsize + 7)
.setPropertyValue("Width", 2 * Fontsize + 20)
End With
oDialogModel.insertByName("PB2", oMod)
oDialog1.setModel(oDialogModel)
REM ***** Listener für den Weiter Button
oPBListener1 = createUnoListener("PB1_", "com.sun.star.awt.XActionListener")
oControl = oDialog1.getControl("PB1")
oControl.addActionListener(oPBListener1)
REM ***** Listener für den Abbruch Button
oPBListener2 = createUnoListener("PB2_", "com.sun.star.awt.XActionListener")
oControl = oDialog1.getControl("PB2")
oControl.addActionListener(oPBListener2)
REM ***** Mittels des Modells den Dialog anzeigen
oWindow = CreateUnoService("com.sun.star.awt.Toolkit")
oDialog1.createPeer(oWindow, null)
oDialog1.execute()
End Sub
REM ***** Die Aktion des Listeners für den Weiter-Button
Sub PB1_actionPerformed(oEvent1)
Dim i As Integer
Dim count_cbState As Integer
Dim cbState As Boolean
Dim Datum_String As String
Datum_String = Format(Date, "YYYY-MM-DD")
count_cbState = 0
If Schiesstag = 1 Then
REM ***** Trage 1. Schiesstag in Tabelle "Saison" ein
Query = "UPDATE ""Saison"" SET ""Beginn"" = {D '"& Datum_string &"'} WHERE ""Saison"" = "& Saison &" AND ""Aktiv"" = 'True'"
Statement.executeUpdate(Query)
End If
REM ***** Werte aus Dialogfeld auslesen
For i = 0 to UBOUND(Class())
REM ***** CeckBox-Status im Dialog ansprechen
CB = oDialog1.getControl(Class(i,0))
REM ***** CeckBox-Status im Dialog auslesen
cbState= CB.state
REM ***** Daten in Tabelle "Fleischpreise_Schiesstag" schreiben
Query = "INSERT INTO ""Fleischpreise_Schiesstag"" (""Schiesstag"", ""Klasse"", ""Fleisch"") VALUES ("& Schiesstag &", '"& Class(i,0) &"', '"& cbState &"')"
Statement.executeUpdate(Query)
Dim days As Integer
days = Class(i,1)
REM ***** Zähle Anzahl Klassen mit Fleisch
If cbState Then
count_cbState = count_cbState + 1
End If
REM ***** Reduzieren Anzahl Fleischpreise
If cbState Then
If days > 0 Then
REM ***** Anzahl Tage um 1 reduzieren
days = days - 1
Query = "UPDATE ""Fleischpreise_Anzahl"" SET ""Tage"" = "& days &" WHERE ""Klasse"" = '"& Class(i,0) &"'"
Statement.executeUpdate(Query)
End If
End If
Next i
REM ***** Überprüfe ob wirklich Fleisch geschossen wird
If count_cbState > 0 Then
Fleisch = True
Else
Fleisch = False
End If
REM ***** Aktuellen Schiesstag in Tabelle "Schiesstage" schreiben.
Query = "INSERT INTO ""Schiesstage"" (""Saison"", ""Datum"", ""Schiesstag"", ""Fleisch"") VALUES ("& Saison &", {D '"& Datum_String &"'}, "& Schiesstag &", '"& Fleisch &"')"
Statement.executeUpdate(Query)
REM *****Entfernen der Listener
oDialog1.getControl("PB1").removeActionListener(oPBListener1)
oDialog1.getControl("PB2").removeActionListener(oPBListener2)
oDialog1.EndExecute()
End Sub
REM ***** Die Aktion des Listeners für den Abbruch-Button
Sub PB2_actionPerformed(oEvent2)
REM *****Entfernen der Listener
oDialog1.getControl("PB1").removeActionListener(oPBListener1)
oDialog1.getControl("PB2").removeActionListener(oPBListener2)
REM *****Schliessen des Dialogs
oDialog1.EndExecute()
End Sub
Die anderen Makros sind nach dem gleichen Schema aufgebaut.
Gruß
Buddy0815
Hallo,
die Daten werden folgendermaßen in die Datenbank geschrieben:
[code]
Query = "INSERT INTO ..."
Statement.executeUpdate(Query)
[/code]
Die Makros laufen ja auch ohne Fehler durch.
in 2 von 8 Fällen sind die Daten jedoch beim nächsten Starten des Rechners weg.
Hier mal der komplette Code eines Makros:
[code]
REM ***** Neuen Schiesstag anlegen *****
Dim DatabaseContext As Object
Dim DataSource As Object
Dim Connection As Object
Dim InteractionHandler as Object
Dim Statement As Object
Dim ResultSet As Object
Dim Query As String
Dim oDialog1 As Object
Dim oPBListener1
Dim oPBListener2
Dim Class() As String
Dim Saison As Integer
Dim Schiesstag As Integer
Dim Fleisch As Boolean
Dim Fontsize As Integer
Dim Font As String
Sub Neuer_Schiesstag
Dim Datum_string As String
Dim Class_Fleisch As Integer
DatabaseContext = createUnoService("com.sun.star.sdb.DatabaseContext")
DataSource = DatabaseContext.getByName("Datenbank")
If Not DataSource.IsPasswordRequired Then
Connection = DataSource.GetConnection("","")
Else
InteractionHandler = createUnoService("com.sun.star.sdb.InteractionHandler")
Connection = DataSource.ConnectWithCompletion(InteractionHandler)
End If
Statement = Connection.createStatement()
Statement.setPropertyValue("ResultSetType",1004)
REM ***** Schrift initialisieren
Font = "Arial"
Fontsize = 10
REM ***** Aktuelle Saison auslesen *****
Query = "SELECT * FROM ""Saison"" WHERE ""Aktiv"" = 'True'"
ResultSet = Statement.executeQuery(Query)
If Not IsNull(ResultSet) Then
If Not ResultSet.Next Then
REM ***** Keine aktive Saison gefunden
MsgBox "Keine aktive Saison gefunden!", MB_ICONSTOP, "Fehler"
Else
REM ***** Aktuelle Saison speichern
Saison = ResultSet.getInt(1)
If ResultSet.getString(2) = "" Then
Rem ***** Erster Schiesstag in Saison
Schiesstag = 1
Fleisch = True
End If
REM ***** Überprüfe ob für heutiges Datum bereits ein Schiesstag begonnen wurde *****
Query = "SELECT ""Schiesstag"" FROM ""Schiesstage"" WHERE ""Schiesstage"".""Datum"" = CURRENT_DATE"
ResultSet = Statement.executeQuery(Query)
ResultSet.last()
If ResultSet.getRow() > 0 Then
MsgBox "Für das heutige Datum wurde bereits ein Schiesstag begonnen!", MB_ICONSTOP, "Fehler"
Else
REM ***** Suche nach letzten Schiesstag in aktueller Saison
Query = "SELECT MAX(""Schiesstag"") FROM ""Schiesstage"" WHERE ""Saison"" = "& Saison &""
ResultSet = Statement.executeQuery(Query)
If Not IsNull(ResultSet) Then
While ResultSet.next
' MsgBox ResultSet.getString(1)
REM ***** Erhöhe gefundenen Schiesstag in aktueller Saison
Schiesstag = ResultSet.getInt(1) + 1
REM ***** Wurde am letzten Schiesstag Fleisch geschossen?
Query = "SELECT ""Fleisch"" FROM ""Schiesstage"" WHERE ""Schiesstag"" = "& ResultSet.getInt(1) &" AND ""Saison"" = "& Saison &""
ResultSet = Statement.executeQuery(Query)
If Not IsNull(ResultSet) Then
If ResultSet.next Then
REM *** Setze Fleisch für aktuellen Schiesstag
Fleisch = ResultSet.getInt(1)
Fleisch = Not Fleisch
End If
End If
Wend
End If
Query = "SELECT * FROM ""Fleischpreise_Anzahl"""
ResultSet = Statement.executeQuery(Query)
ResultSet.last()
Dim iCounter As Integer
iCounter = ResultSet.getrow()
ReDim Class(iCounter - 1,1)
Class_Fleisch = 0
For i = 1 to iCounter
REM ***** Speichere Klassen in Array
ResultSet.absolute(i)
Class(i - 1,0) = ResultSet.getString(1)
Class(i - 1,1) = ResultSet.getInt(2)
REM ***** Zähle Anzahl Klassen mit Fleisch
If Fleisch And ResultSet.getInt(2) > 0 Then
Class_Fleisch = Class_Fleisch + 1
End If
Next i
REM ***** Es gibt keine Klassen mehr die Fleisch schiessen
If Fleisch AND Class_Fleisch = 0 Then
Fleisch = False
End If
REM ***** Dialog aufrufen
Call Dialog_Neuer_Schiesstag
End If
End If
End If
REM ***** Schliesse Verbindungen *****
Statement.close()
Connection.close()
End Sub
REM ***** Dialog für neuen Schiesstag
Sub Dialog_Neuer_Schiesstag
Dim oDialogModel As Object
Dim oWindow As Object
Dim oMod As Object
Dim oEvent1
Dim oEvent2
Dim i As Integer
REM ***** Initialisierung der Eigenschaften des Dialogs
oDialogModel = CreateUnoService("com.sun.star.awt.UnoControlDialogModel")
With oDialogModel
.setPropertyValue("PositionX", 50)
.setPropertyValue("PositionY", 50 )
.setPropertyValue("FontName", Font)
.setPropertyValue("FontHeight", Fontsize)
.setPropertyValue("Width", 150)
.setPropertyValue("Height", (Fontsize + 23) * (UBOUND(Class())+ 1))
.setPropertyValue("Title", "Neuen Schiesstag beginnen")
' .setPropertyValue("HelpText", "Wird Fleisch geschossen?")
End With
oDialog1 = CreateUnoService("com.sun.star.awt.UnoControlDialog")
REM ***** Textlabel erzeugen
oMod = oDialogModel.createInstance("com.sun.star.awt.UnoControlFixedTextModel")
With oMod
.setPropertyValue("Label", "Schiesstag: " & Schiesstag)
.setPropertyValue("Name", "LabelSD")
.setPropertyValue("PositionX", 10)
.setPropertyValue("PositionY", Fontsize)
.setPropertyValue("FontName", Font)
.setPropertyValue("FontHeight", Fontsize)
.setPropertyValue("Height", Fontsize + 2)
.setPropertyValue("Width", 80)
.setPropertyValue("HelpText", "Aktueller Schiesstag")
End With
oDialogModel.insertByName("LabelSD", oMod)
REM ***** Textlabel erzeugen
oMod = oDialogModel.createInstance("com.sun.star.awt.UnoControlFixedTextModel")
With oMod
.setPropertyValue("Label", Format(Date, "DD.MM.YYYY"))
.setPropertyValue("Name", "LabelDate")
.setPropertyValue("PositionX", 90)
.setPropertyValue("PositionY", Fontsize)
.setPropertyValue("Align", 2)
.setPropertyValue("FontName", Font)
.setPropertyValue("FontHeight", Fontsize)
.setPropertyValue("Height", Fontsize + 2)
.setPropertyValue("Width", 50)
.setPropertyValue("HelpText", "Datum")
End With
oDialogModel.insertByName("LabelDate", oMod)
REM ***** Linie erzeugen
oMod = oDialogModel.createInstance("com.sun.star.awt.UnoControlFixedLineModel")
With oMod
.setPropertyValue("Name", "FixedLabel")
.setPropertyValue("PositionX", 10)
.setPropertyValue("PositionY", Fontsize * 2)
.setPropertyValue("Height", 5)
.setPropertyValue("Width", 130)
End With
oDialogModel.insertByName("FixedLabel", oMod)
For i = 1 to UBOUND(Class()) + 1
REM ***** Textlabel erzeugen
oMod = oDialogModel.createInstance("com.sun.star.awt.UnoControlFixedTextModel")
With oMod
.setPropertyValue("Label", "Klasse " & Class(i-1,0) & ":")
.setPropertyValue("Name", "Label" & i + 1)
.setPropertyValue("PositionX", 30)
.setPropertyValue("PositionY", (Fontsize * 2) + (i * (Fontsize + 5)))
.setPropertyValue("Align", 2)
.setPropertyValue("FontName", Font)
.setPropertyValue("FontHeight", Fontsize)
.setPropertyValue("Height", Fontsize + 2)
.setPropertyValue("Width", 40)
End With
oDialogModel.insertByName("Label" & i, oMod)
REM ***** Checkboxen erzeugen
oMod = oDialogModel.createInstance("com.sun.star.awt.UnoControlCheckBoxModel")
With oMod
.setPropertyValue("Label", " ~Fleisch ("& Class(i-1,1) &")")
.setPropertyValue("Name", Class(i-1,0))
.setPropertyValue("PositionX", 75)
.setPropertyValue("PositionY", (Fontsize * 2) + (i * (Fontsize + 5)))
.setPropertyValue("Align", 0)
.setPropertyValue("VerticalAlign", 0)
.setPropertyValue("FontName", Font)
.setPropertyValue("FontHeight", Fontsize)
.setPropertyValue("Height", Fontsize + 2)
.setPropertyValue("Width", 55)
'REM ***** Initialisiere Checkboxen
If Fleisch AND Class(i-1,1) > 0 Then
.setPropertyValue("State", 1)
Else
.setPropertyValue("State", 0)
End If
If Class(i-1,1) = 0 Then
.setPropertyValue("Enabled", False)
End If
End With
oDialogModel.insertByName(Class(i-1,0), oMod)
Next i
REM ***** Pushbutton erzeugen
oMod = oDialogModel.createInstance("com.sun.star.awt.UnoControlButtonModel")
With oMod
.setPropertyValue("Label", "Weiter")
.setPropertyValue("Name", "PB1")
.setPropertyValue("PositionX", 35)
.setPropertyValue("PositionY", oDialogModel.Height - 30)
.setPropertyValue("FontName", Font)
.setPropertyValue("FontHeight", Fontsize)
.setPropertyValue("Height", Fontsize + 7)
.setPropertyValue("Width", 2 * Fontsize + 20)
End With
oDialogModel.insertByName("PB1", oMod)
REM ***** Pushbutton erzeugen
oMod = oDialogModel.createInstance("com.sun.star.awt.UnoControlButtonModel")
With oMod
.setPropertyValue("Label", "Abbruch")
.setPropertyValue("Name", "PB2")
.setPropertyValue("PositionX", 80)
.setPropertyValue("PositionY", oDialogModel.Height - 30)
.setPropertyValue("FontName", Font)
.setPropertyValue("FontHeight", Fontsize)
.setPropertyValue("Height", Fontsize + 7)
.setPropertyValue("Width", 2 * Fontsize + 20)
End With
oDialogModel.insertByName("PB2", oMod)
oDialog1.setModel(oDialogModel)
REM ***** Listener für den Weiter Button
oPBListener1 = createUnoListener("PB1_", "com.sun.star.awt.XActionListener")
oControl = oDialog1.getControl("PB1")
oControl.addActionListener(oPBListener1)
REM ***** Listener für den Abbruch Button
oPBListener2 = createUnoListener("PB2_", "com.sun.star.awt.XActionListener")
oControl = oDialog1.getControl("PB2")
oControl.addActionListener(oPBListener2)
REM ***** Mittels des Modells den Dialog anzeigen
oWindow = CreateUnoService("com.sun.star.awt.Toolkit")
oDialog1.createPeer(oWindow, null)
oDialog1.execute()
End Sub
REM ***** Die Aktion des Listeners für den Weiter-Button
Sub PB1_actionPerformed(oEvent1)
Dim i As Integer
Dim count_cbState As Integer
Dim cbState As Boolean
Dim Datum_String As String
Datum_String = Format(Date, "YYYY-MM-DD")
count_cbState = 0
If Schiesstag = 1 Then
REM ***** Trage 1. Schiesstag in Tabelle "Saison" ein
Query = "UPDATE ""Saison"" SET ""Beginn"" = {D '"& Datum_string &"'} WHERE ""Saison"" = "& Saison &" AND ""Aktiv"" = 'True'"
Statement.executeUpdate(Query)
End If
REM ***** Werte aus Dialogfeld auslesen
For i = 0 to UBOUND(Class())
REM ***** CeckBox-Status im Dialog ansprechen
CB = oDialog1.getControl(Class(i,0))
REM ***** CeckBox-Status im Dialog auslesen
cbState= CB.state
REM ***** Daten in Tabelle "Fleischpreise_Schiesstag" schreiben
Query = "INSERT INTO ""Fleischpreise_Schiesstag"" (""Schiesstag"", ""Klasse"", ""Fleisch"") VALUES ("& Schiesstag &", '"& Class(i,0) &"', '"& cbState &"')"
Statement.executeUpdate(Query)
Dim days As Integer
days = Class(i,1)
REM ***** Zähle Anzahl Klassen mit Fleisch
If cbState Then
count_cbState = count_cbState + 1
End If
REM ***** Reduzieren Anzahl Fleischpreise
If cbState Then
If days > 0 Then
REM ***** Anzahl Tage um 1 reduzieren
days = days - 1
Query = "UPDATE ""Fleischpreise_Anzahl"" SET ""Tage"" = "& days &" WHERE ""Klasse"" = '"& Class(i,0) &"'"
Statement.executeUpdate(Query)
End If
End If
Next i
REM ***** Überprüfe ob wirklich Fleisch geschossen wird
If count_cbState > 0 Then
Fleisch = True
Else
Fleisch = False
End If
REM ***** Aktuellen Schiesstag in Tabelle "Schiesstage" schreiben.
Query = "INSERT INTO ""Schiesstage"" (""Saison"", ""Datum"", ""Schiesstag"", ""Fleisch"") VALUES ("& Saison &", {D '"& Datum_String &"'}, "& Schiesstag &", '"& Fleisch &"')"
Statement.executeUpdate(Query)
REM *****Entfernen der Listener
oDialog1.getControl("PB1").removeActionListener(oPBListener1)
oDialog1.getControl("PB2").removeActionListener(oPBListener2)
oDialog1.EndExecute()
End Sub
REM ***** Die Aktion des Listeners für den Abbruch-Button
Sub PB2_actionPerformed(oEvent2)
REM *****Entfernen der Listener
oDialog1.getControl("PB1").removeActionListener(oPBListener1)
oDialog1.getControl("PB2").removeActionListener(oPBListener2)
REM *****Schliessen des Dialogs
oDialog1.EndExecute()
End Sub[/code]
Die anderen Makros sind nach dem gleichen Schema aufgebaut.
Gruß
Buddy0815