Option Compare Database
Option Explicit
Private Const mconKeys As String = modPublDecl.gconSpace & "Key(s)"
Private Const mconV As String * 1 = "V"
Private Const mconKeyDel As String = "or dem Laden zu löschende(r)" & mconKeys
Private Const mconKeyAvail As String = mconV & "orhandene(r)" & mconKeys
Private Const mconCboField As String = "Kombinationsfeld" & modPublDecl.gconSpace
Private Const mconUpdate As String = modPublDecl.gconSpace & "aktualisieren"
Private mlngDCID As Long
Private mstrTabelle As String
Private mlngDelDCID As Long
Private mstrDelDCID As String
Private mstrDelTabelle As String
Private mstrDelKey As String
Private mboolOpenOK As Boolean
Public mboolDeleteAllKeys As Boolean
'-------------------------------------------------------------------------------------'
' Prozedur: Form_Open
'
' Beschreibung: Öffnet das Formular. Falls das Formular modPublDecl.gconFrmCM nicht
' geöffnet ist, wird eine Fehlermeldung angezeigt der Öffnen Vorgang
' abgebrochen.
'
' Parameter: Cancel
'-------------------------------------------------------------------------------------'
Private Sub Form_Open(Cancel As Integer)
On Error GoTo Form_Open_Err
If modPublic.IsFormOpen(modPublDecl.gconFrmCM) = False Then
mboolOpenOK = False
Cancel = True
Resume Form_Open_Err
Else
mboolOpenOK = True
End If
Form_Open_Exit:
Exit Sub
Form_Open_Err:
If Err.Number <> 0 Then
Call modPublic.FormReportNotOpen(True, _
True, _
modPublDecl.gconFrmCM, _
Me.Name)
End If
Resume Form_Open_Exit
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: Form_Load
'
' Beschreibung: Lädt das Formular, aktualisiert alle Steuerelemente und setzt den
' Formulartitel.
'
' Parameter: Ohne
'-------------------------------------------------------------------------------------'
Private Sub Form_Load()
On Error GoTo Form_Load_Err
Dim boolKeysSaved As Boolean
Dim lngMaxDelDCID As Long
If mboolOpenOK = True Then
With Forms(modPublDecl.gconFrmCM)
mlngDCID = .txtDCID
mlngDelDCID = .txtDCID
End With
With Me
If KeysSaved(mlngDCID, _
lngMaxDelDCID) = True Then
Call modPublic.SetStatusBarText(19, _
False, _
0)
If lngMaxDelDCID > 0 Then
.cboDCID.Value = lngMaxDelDCID
End If
mstrTabelle = "*"
Call cboTabelleRefresh(True)
Call lstKeyRefresh("*", _
"*")
Call UpdDelKeyControls(mlngDelDCID)
With .cboDelDCID
If .Enabled = True Then
.SetFocus
End If
End With
Else
.lstKey.RowSource = vbNullString
Call KeyRefresh
.lstKeyDel.RowSource = vbNullString
Call DelKeyRefresh
With .cboDCID
.SetFocus
.Value = .ItemData(0)
.Dropdown
End With
End If
.Caption = modPublDecl.gconAppTitle & mconV & mconKeyDel & _
modPublDecl.gconSpace & "[DCID" & modPublDecl.gconSpace & _
Format(mlngDCID, modPublDecl.gconlngDCIDFmt) & "]"
End With
End If
Form_Load_Exit:
SysCmd acSysCmdRemoveMeter
Exit Sub
Form_Load_Err:
Call modPublic.ShowMsgBox("Fehler beim Laden des Formulars!", _
modPublDecl.gconOkExcStyle, _
"Formular" & modPublDecl.gconSpace & Me.Name & _
modPublDecl.gconSpace & "laden", _
True)
Resume Form_Load_Exit
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: cboDCID_AfterUpdate
'
' Beschreibung: In Abhängigkeit vom Inhalt des Steuerelements cboDCID wird das
' Steuerelement lstKey aktualisiert.
'
' Parameter: Ohne
'-------------------------------------------------------------------------------------'
Private Sub cboDCID_AfterUpdate()
On Error GoTo cboDCID_AfterUpdate_Err
Call modPublic.SetStatusBarText(19, _
False, _
0)
If Me.cboDCID.Value <> mlngDCID Then
Call cboDCIDRefresh(True)
Else
Call cboDCIDRefresh(False)
End If
Call lstKeyRefresh("*", _
"*")
cboDCID_AfterUpdate_Exit:
SysCmd acSysCmdRemoveMeter
Exit Sub
cboDCID_AfterUpdate_Err:
Call modPublic.ShowMsgBox(Err.Description, _
modPublDecl.gconOkExcStyle, _
mconCboField & "DCID" & mconUpdate, _
True)
Resume cboDCID_AfterUpdate_Exit
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: cboDCIDRefresh
'
' Beschreibung: Legt die Datenherkunft des Steuerelements cboDCID fest.
'
' Parameter: boolInit
'-------------------------------------------------------------------------------------'
Private Sub cboDCIDRefresh(ByVal boolInit As Boolean)
Dim strSQL As String
With Me.cboDCID
If Not IsNull(.Value) Then
strSQL = modSQL.QSelDistDCTablesKey("tblDB2DMCMDCTablesKey", _
.Value, _
"*", _
"*", _
"DCID")
Call cboTabelleRefresh(boolInit)
ElseIf IsNull(.Value) Then
Call lstKeyRequery(vbNullString)
End If
End With
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: cboTabelle_AfterUpdate
'
' Beschreibung: Aktualisert die Steuerelemente lstKey und lstKeyDel.
'
' Parameter: Ohne
'-------------------------------------------------------------------------------------'
Private Sub cboTabelle_AfterUpdate()
On Error GoTo cboTabelle_AfterUpdate_Err
Call modPublic.SetStatusBarText(19, _
False, _
0)
mstrTabelle = IIf(Me.cboTabelle.Value = modPublDecl.gconSelectAll, _
"*", _
Me.cboTabelle.Value)
Call cboTabelleRefresh(False)
Call lstKeyRefresh(mstrTabelle, _
"*")
cboTabelle_AfterUpdate_Exit:
SysCmd acSysCmdRemoveMeter
Exit Sub
cboTabelle_AfterUpdate_Err:
Call modPublic.ShowMsgBox(Err.Description, _
modPublDecl.gconOkExcStyle, _
mconCboField & "Tabelle" & mconUpdate, _
True)
Resume cboTabelle_AfterUpdate_Exit
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: cboTabelleRefresh
'
' Beschreibung: Legt die Datenherkunft des Steuerelements cboTabelle fest.
'
' Parameter: boolInit
'-------------------------------------------------------------------------------------'
Private Sub cboTabelleRefresh(ByVal boolInit As Boolean)
Dim strSQL As String
With Me
strSQL = modSQL.QSelDistDCKeyTables("tblDB2DMCMDCTablesKey", _
CLng(.cboDCID.Value), _
vbNullString)
With .cboTabelle
.RowSource = strSQL
If boolInit = True Then
.Value = .ItemData(0)
End If
End With
End With
Call lstKeyRequery(strSQL)
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: lstKeyRefresh
'
' Beschreibung: Aktualisert das Steuerelement lstKey.
'
' Parameter: strTabelle
' strKey
'-------------------------------------------------------------------------------------'
Private Sub lstKeyRefresh(ByVal strTabelle As String, _
ByVal strKey As String)
Dim strSQL As String
strSQL = modSQL.QSelDistDCTablesKey("tblDB2DMCMDCTablesKey", _
CLng(Me.cboDCID.Value), _
strTabelle, _
strKey, _
"DB2KeyVal")
Call lstKeyRequery(strSQL)
Call KeyRefresh
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: cboDelDCID_AfterUpdate
'
' Beschreibung: Ruft die Funktionen cboDelTabelleRefresh und cboDelKeyRefresh auf.
'
' Parameter: Ohne
'-------------------------------------------------------------------------------------'
Private Sub cboDelDCID_AfterUpdate()
On Error GoTo cboDelDCID_AfterUpdate_Err
Dim lngInd As Long
With Me.cboDelDCID
If .Value <> mstrDelDCID And .ListCount > 2 Then
Call modPublic.HourGlassState(True)
Call modPublic.SetStatusBarText(19, _
False, _
0)
lngInd = .ListIndex
Call cboDelTabelleRefresh(True)
Call cboDelKeyRefresh(True)
Call lstKeyDelRefresh
.Value = .ItemData(lngInd)
.SetFocus
Call modPublic.HourGlassState(False)
End If
mstrDelDCID = .Value
End With
cboDelDCID_AfterUpdate_Exit:
SysCmd acSysCmdRemoveMeter
Exit Sub
cboDelDCID_AfterUpdate_Err:
Call modPublic.ShowMsgBox(Err.Description, _
modPublDecl.gconOkExcStyle, _
mconCboField & "DCID" & mconUpdate, _
True)
Resume cboDelDCID_AfterUpdate_Exit
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: cboDelTabelleRefresh
'
' Beschreibung: Legt die Datenherkunft des Steuerelements cboDelDCID fest.
'
' Parameter: boolInit
' strDelDCID
'-------------------------------------------------------------------------------------'
Private Sub cboDelDCIDRefresh(ByVal boolInit As Boolean, _
ByVal strDelDCID As String)
Dim strSQL As String
strSQL = modSQL.QSelDistDelDCID(strDelDCID)
With Me
.cboDelKey.Value = .cboDelKey.ItemData(0)
With .cboDelDCID
.RowSource = strSQL
If .ListCount > 0 Then
Me.cboDelTabelle.Enabled = True
.Enabled = True
.SetFocus
If boolInit = True Then
.Value = .ItemData(0)
End If
Else
Me.cboDelTabelle.Enabled = False
End If
End With
End With
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: cboDelTabelle_AfterUpdate
'
' Beschreibung: Ruft die Funktionen cboDelTabelleRefresh und cboDelKeyRefresh auf.
'
' Parameter: Ohne
'-------------------------------------------------------------------------------------'
Private Sub cboDelTabelle_AfterUpdate()
On Error GoTo cboDelTabelle_AfterUpdate_Err
Dim lngInd As Long
With Me.cboDelTabelle
If .Value <> mstrDelTabelle And .ListCount > 2 Then
Call modPublic.HourGlassState(True)
Call modPublic.SetStatusBarText(19, _
False, _
0)
lngInd = .ListIndex
Call cboDelTabelleRefresh(True)
Call cboDelKeyRefresh(True)
.Value = .ItemData(lngInd)
Call lstKeyDelRefresh
.SetFocus
Call modPublic.HourGlassState(False)
End If
mstrDelTabelle = Me.cboDelTabelle.Value
End With
cboDelTabelle_AfterUpdate_Exit:
SysCmd acSysCmdRemoveMeter
Exit Sub
cboDelTabelle_AfterUpdate_Err:
Call modPublic.ShowMsgBox(Err.Description, _
modPublDecl.gconOkExcStyle, _
mconCboField & "Tabelle" & mconUpdate, _
True)
Resume cboDelTabelle_AfterUpdate_Exit
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: cboDelTabelleRefresh
'
' Beschreibung: Legt die Datenherkunft des Steuerelements cboDelTabelle fest.
'
' Parameter: boolInit
'-------------------------------------------------------------------------------------'
Private Sub cboDelTabelleRefresh(ByVal boolInit As Boolean)
Dim strSQL As String
Dim strDelDCID As String
Dim strDelTabelle As String
With Me
If boolInit = True Then
strDelDCID = "*"
strDelTabelle = "*"
Else
With .cboDelDCID
strDelDCID = IIf(.Value = modPublDecl.gconSelectAll, _
"*", _
.Value)
End With
With .cboDelTabelle
strDelTabelle = IIf(.Value = modPublDecl.gconSelectAll, _
"*", _
.Value)
End With
End If
strSQL = modSQL.QSelDistDCKeyTables("tblDB2DMCMDCTablesKeyDelete", _
mlngDCID, _
strDelDCID)
With .cboDelTabelle
.RowSource = strSQL
If .ListCount > 0 Then
Me.cboDelKey.Enabled = True
.SetFocus
If boolInit = True Then
.Value = .ItemData(0)
End If
Else
Me.cboDelTabelle.Enabled = False
End If
End With
End With
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: cboDelKey_AfterUpdate
'
' Beschreibung: Ruft die Funktion cboDelKeyRefresh auf.
'
' Parameter: Ohne
'-------------------------------------------------------------------------------------'
Private Sub cboDelKey_AfterUpdate()
On Error GoTo cboDelKey_AfterUpdate_Err
Dim lngInd As Long
With Me.cboDelKey
If .Value <> mstrDelKey And .ListCount > 2 Then
Call modPublic.HourGlassState(True)
Call modPublic.SetStatusBarText(19, _
False, _
0)
lngInd = .ListIndex
Call cboDelKeyRefresh(True)
.Value = .ItemData(lngInd)
Call lstKeyDelRefresh
.SetFocus
Call modPublic.HourGlassState(False)
End If
mstrDelKey = .Value
End With
cboDelKey_AfterUpdate_Exit:
SysCmd acSysCmdRemoveMeter
Exit Sub
cboDelKey_AfterUpdate_Err:
Call modPublic.ShowMsgBox(Err.Description, _
modPublDecl.gconOkExcStyle, _
mconCboField & "Key" & mconUpdate, _
True)
Resume cboDelKey_AfterUpdate_Exit
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: cboDelKeyRefresh
'
' Beschreibung: Legt die Datenherkunft des Steuerelements cboDelKey fest.
'
' Parameter: boolInit
'-------------------------------------------------------------------------------------'
Private Sub cboDelKeyRefresh(ByVal boolInit As Boolean)
Dim strSQL As String
Dim strDelDCID As String
Dim strDelTabelle As String
With Me
With .cboDelDCID
strDelDCID = IIf(.Value = modPublDecl.gconSelectAll = True, _
"*", _
.Value)
End With
With .cboDelTabelle
strDelTabelle = IIf(.Value = modPublDecl.gconSelectAll = True, _
"*", _
.Value)
End With
strSQL = modSQL.QSelDistDelKeyDB2KeyVal(mlngDCID, _
strDelDCID, _
strDelTabelle)
With .cboDelKey
.RowSource = strSQL
Select Case .ListCount > 0
Case True
.Enabled = True
.SetFocus
If boolInit = True Then
.Value = .ItemData(0)
End If
Case False
.Enabled = False
End Select
End With
End With
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: lstKey_DblClick
'
' Beschreibung: Löscht bei dem mit Doppelklick ausgewählten Key den Datensatz aus der
' Tabelle tblDB2DMCMDCTablesKeyDelete.
'
' Parameter: Cancel
'-------------------------------------------------------------------------------------'
Private Sub lstKey_DblClick(Cancel As Integer)
On Error GoTo lstKey_DblClick_Err
Dim dbDAOKey As DAO.Database
Dim rstDAOKey As DAO.Recordset
Dim dbDAODelKey As DAO.Database
Dim rstDAODelKey As DAO.Recordset
Dim strSQL As String
Dim strTabelle As String
With Me
With .cboTabelle
strTabelle = IIf(.Value = modPublDecl.gconSelectAll, _
"*", _
.Value)
End With
strSQL = modSQL.QSelCorrDCTables(.cboDCID, _
strTabelle, _
.lstKey.Column(1))
Set dbDAOKey = CurrentDb()
Set rstDAOKey = dbDAOKey.OpenRecordset(strSQL, _
dbOpenSnapshot)
strSQL = modSQL.QSelDelTable("tblDB2DMCMDCTablesKeyDelete", _
False)
Set dbDAODelKey = CurrentDb()
Set rstDAODelKey = dbDAODelKey.OpenRecordset(strSQL, _
dbOpenDynaset)
With rstDAOKey
Do Until .EOF
Call UpdDelDCID(rstDAODelKey, _
Forms(modPublDecl.gconFrmCM).txtDCID, _
Me.lstKey.Column(0), _
!Tabelle, _
!DB2KeyVal)
.MoveNext
Loop
.Close
rstDAODelKey.Close
End With
Call UpdDelKeyControls(mlngDCID)
.lstKey.SetFocus
End With
lstKey_DblClick_Exit:
SysCmd acSysCmdRemoveMeter
Set dbDAOKey = Nothing
Set rstDAOKey = Nothing
Set dbDAODelKey = Nothing
Set rstDAODelKey = Nothing
Exit Sub
lstKey_DblClick_Err:
Select Case Err.Number
Case 94 ' Keine Tabelle ausgewählt
Call modPublic.ShowMsgBox("Bitte wählen Sie zuerst eine Tabelle aus.", _
modPublDecl.gconOkInfStyle, _
"Keine Tabelle ausgewählt", _
True)
Case Else
Call modPublic.ShowMsgBox("Bitte wählen Sie ggf. eine Kombination " & _
"aus DCID und Tabelle.", _
modPublDecl.gconOkExcStyle, _
"Key '" & Trim(Me.lstKey.Column(1)) & "' hinzufügen", _
True)
End Select
Resume lstKey_DblClick_Exit
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: cmdAddSelected_Click
'
' Beschreibung: Fügt die Keys der ausgewählten Keys (Mehrfachauswahl) der Tabelle
' tblDB2DMCMDCTablesKeyDelete hinzu.
'
' Parameter: Ohne
'-------------------------------------------------------------------------------------'
Private Sub cmdAddSelected_Click()
On Error GoTo cmdAddSelected_Click_Err
Const conAddSelKeys As String = "Ausgewählte Keys hinzufügen"
Dim dbDAOKey As DAO.Database
Dim rstDAOKey As DAO.Recordset
Dim dbDAODelKey As DAO.Database
Dim rstDAODelKey As DAO.Recordset
Dim strSQL As String
Dim avntElement As Variant
Dim strTabelle As String
Dim lngNumKeys As Long
Dim lngErrCnt As Long
With Me
If .lstKey.ItemsSelected.Count > 0 Then
With .cboTabelle
strTabelle = IIf(.Value = modPublDecl.gconSelectAll, _
"*", _
.Value)
End With
lngNumKeys = .lstKey.ItemsSelected.Count
If modPublic.ShowMsgBox(lngNumKeys & " ausgewählte Keys zur Liste " & _
"der zu löschenden Keys hinzufügen?" & _
vbCrLf & vbCrLf & _
"Der Vorgang nimmt u.U. einige Zeit in Anspruch!", _
modPublDecl.gconYNDef2QuestStyle, _
conAddSelKeys, _
False) = vbYes Then
Call modPublic.SetStatusBarText(11, _
False, _
0)
For Each avntElement In .lstKey.ItemsSelected
lngNumKeys = lngNumKeys + 1
strSQL = modSQL.QSelCorrDCTables(.cboDCID, _
strTabelle, _
.lstKey.ItemData(avntElement))
Set dbDAOKey = CurrentDb()
Set rstDAOKey = dbDAOKey.OpenRecordset(strSQL, _
dbOpenSnapshot)
strSQL = modSQL.QSelDelTable("tblDB2DMCMDCTablesKeyDelete", _
False)
Set dbDAODelKey = CurrentDb()
Set rstDAODelKey = dbDAODelKey.OpenRecordset(strSQL, _
dbOpenDynaset)
With rstDAOKey
If Not .EOF Then
Call UpdDelDCID(rstDAODelKey, _
Forms(modPublDecl.gconFrmCM).txtDCID, _
Me.lstKey.Column(0, 1), _
rstDAOKey!Tabelle, _
Me.lstKey.ItemData(avntElement))
End If
rstDAODelKey.Close
.Close
End With
Next avntElement
If lngNumKeys <> lngErrCnt Then
Call UpdDelKeyControls(mlngDCID)
End If
End If
Else
Call modPublic.ShowMsgBox("Es wurden keine hinzuzufügenden Keys ausgewählt!", _
modPublDecl.gconOkExcStyle, _
conAddSelKeys, _
True)
End If
End With
cmdAddSelected_Click_Exit:
SysCmd acSysCmdRemoveMeter
Set dbDAOKey = Nothing
Set rstDAOKey = Nothing
Set dbDAODelKey = Nothing
Set rstDAODelKey = Nothing
If lngErrCnt > 0 Then
Call AddKeyError(lngErrCnt)
End If
Exit Sub
cmdAddSelected_Click_Err:
Select Case Err.Number
Case modPublDecl.gconDuplicateKey ' Indexfehler
lngErrCnt = lngErrCnt + 1
Resume Next
Case Else
Call modPublic.ShowMsgBox(Err.Description, _
modPublDecl.gconOkExcStyle, _
conAddSelKeys, _
True)
End Select
Resume cmdAddSelected_Click_Exit
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: cmdAddAllKeys_Click
'
' Beschreibung: Fügt alle Keys an die Tabelle tblDB2DMCMDCTablesKeyDelete an.
'
' Parameter: Ohne
'-------------------------------------------------------------------------------------'
Private Sub cmdAddAllKeys_Click()
On Error GoTo cmdAddAllKeys_Click_Err
Const conAddAllKeys As String = "Alle Keys übernehmen"
Dim dbDAOKey As DAO.Database
Dim rstDAOKey As DAO.Recordset
Dim dbDAODelKey As DAO.Database
Dim rstDAODelKey As DAO.Recordset
Dim strSQL As String
Dim strTabelle As String
Dim strKey As String
Dim lngNumKeys As Long
Dim lngErrCnt As Long
Dim strSubMsg As String
With Me
Select Case .cboTabelle.Value
Case modPublDecl.gconSelectAll, vbNullString
strTabelle = "*"
strSubMsg = "Alle Keys"
Case Else
strTabelle = .cboTabelle
strSubMsg = "Alle Keys der Tabelle " & strTabelle
End Select
If modPublic.ShowMsgBox(strSubMsg & " (Data Collection " & _
Format(.cboDCID, modPublDecl.gconlngDCIDFmt) & _
") übernehmen?", _
modPublDecl.gconYNQuestStyle, _
conAddAllKeys, _
False) = vbYes Then
Call modPublic.SetStatusBarText(10, _
False, _
0)
strSQL = modSQL.QSelCorrDCTables(.cboDCID, _
strTabelle, _
"*")
Set dbDAOKey = CurrentDb()
Set rstDAOKey = dbDAOKey.OpenRecordset(strSQL, _
dbOpenSnapshot)
strSQL = modSQL.QSelDelTable("tblDB2DMCMDCTablesKeyDelete", _
False)
Set dbDAODelKey = CurrentDb()
Set rstDAODelKey = dbDAODelKey.OpenRecordset(strSQL, _
dbOpenDynaset)
With rstDAOKey
Do Until .EOF
lngNumKeys = lngNumKeys + 1
Call UpdDelDCID(rstDAODelKey, _
Forms(modPublDecl.gconFrmCM).txtDCID, _
Me.lstKey.Column(0, 1), _
!Tabelle, _
!DB2KeyVal)
.MoveNext
DoEvents ' Ereignissteuerung an Betriebssystem übergeben
Loop
.Close
rstDAODelKey.Close
End With
If lngNumKeys <> lngErrCnt Then
Call UpdDelKeyControls(mlngDelDCID)
End If
End If
End With
cmdAddAllKeys_Click_Exit:
SysCmd acSysCmdRemoveMeter
Set dbDAOKey = Nothing
Set rstDAOKey = Nothing
Set dbDAODelKey = Nothing
Set rstDAODelKey = Nothing
If lngErrCnt > 0 Then
Call AddKeyError(lngErrCnt)
End If
Exit Sub
cmdAddAllKeys_Click_Err:
Select Case Err.Number
Case modPublDecl.gconDuplicateKey ' Indexfehler
lngErrCnt = lngErrCnt + 1
Resume Next
Case Else
Call modPublic.ShowMsgBox(Err.Description, _
modPublDecl.gconOkExcStyle, _
conAddAllKeys, _
True)
End Select
Resume cmdAddAllKeys_Click_Exit
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: AddKeyError
'
' Beschreibung: Fehlermeldung, falls der/die ausgewählte(n) Key(s) bereits zugeordnet
' wurden.
'
' Parameter: lngErrCnt
'-------------------------------------------------------------------------------------'
Private Sub AddKeyError(ByVal lngErrCnt As Integer)
Call modPublic.ShowMsgBox(lngErrCnt & " Key(s) wurde(n) bereits hinzugefügt.", _
modPublDecl.gconOkExcStyle, _
"Key(s) hinzufügen", _
True)
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: lstKeyDel_DblClick
'
' Beschreibung: Löscht den mit Doppelklick ausgewählten Key aus der Tabelle
' tblDB2DMCMDCTablesKeyDelete.
'
' Parameter: Cancel
'-------------------------------------------------------------------------------------'
Private Sub lstKeyDel_DblClick(Cancel As Integer)
On Error GoTo lstKeyDel_DblClick_Err
Dim strSQL As String
With Me
.lstKey.Requery
If (IsNull(.cboDelDCID) Or IsNull(.cboDelTabelle) Or IsNull(.cboDelKey)) = True Then
Call modPublic.ShowMsgBox("Bitte wählen Sie zuerst eine Kombination aus " & _
vbCrLf & _
"DCID (Kombinationsfeld 'DCID')," & vbCrLf & _
"Tabelle (Kombinationsfeld 'Tabelle')" & vbCrLf & _
"und Key (Kombinationsfeld 'Key').", _
modPublDecl.gconOkInfStyle, _
"Fehlende Auswahl", _
True)
Else
If .lstKeyDel.ListCount > 0 Then
Call modPublic.SetStatusBarText(10, _
False, _
0)
strSQL = modSQL.QDelAllKeys(mlngDCID, _
CStr(.lstKeyDel.Column(1, 1)), _
CStr(.lstKeyDel.Column(2, 1)), _
CStr(.lstKeyDel.Column(3, 1)))
CurrentDb.Execute strSQL
End If
Call UpdDelKeyControls(mlngDelDCID)
End If
.lstKeyDel.SetFocus
End With
lstKeyDel_DblClick_Exit:
SysCmd acSysCmdRemoveMeter
Exit Sub
lstKeyDel_DblClick_Err:
Call modPublic.ShowMsgBox(Err.Description, _
modPublDecl.gconOkExcStyle, _
"Vor dem Laden zu löschenden Key löschen", _
True)
Resume lstKeyDel_DblClick_Exit
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: cmdDeleteSelected_Click
'
' Beschreibung: Löscht alle markierten Keys (Mehrfachauswahl) aus der Tabelle
' tblDB2DMCMDCTablesKeyDelete.
'
' Parameter: Ohne
'-------------------------------------------------------------------------------------'
Private Sub cmdDeleteSelected_Click()
On Error GoTo cmdDeleteSelected_Click_Err
Const conDelSelKeys As String = "Ausgewählte Keys löschen"
Dim strSQL As String
Dim avntElement As Variant
Dim strTabelle As String
Dim lngNumKeys As Long
With Me.lstKeyDel
If .ItemsSelected.Count > 0 Then
lngNumKeys = .ItemsSelected.Count
If modPublic.ShowMsgBox(lngNumKeys & modPublDecl.gconSpace & LCase(mconV) & _
mconKeyDel & " löschen?" & vbCrLf & vbCrLf & _
"Der Vorgang kann mehrere Minuten dauern!", _
modPublDecl.gconYNDef2QuestStyle, _
conDelSelKeys, _
False) = vbYes Then
mboolDeleteAllKeys = False
modPublDecl.glngNumKeys = lngNumKeys
Call modPublic.SetStatusBarText(8, _
False, _
0)
Call modPublic.HourGlassState(True)
For Each avntElement In .ItemsSelected
strSQL = modSQL.QDelAllKeys(CStr(.Column(0, avntElement)), _
CStr(.Column(1, avntElement)), _
CStr(.Column(2, avntElement)), _
CStr(.Column(3, avntElement)))
CurrentDb.Execute strSQL
modPublDecl.glngNumKeys = modPublDecl.glngNumKeys - 1
Call modPublic.SetStatusBarText(8, _
False, _
0)
DoEvents ' Ereignissteuerung an Betriebssystem übergeben
Next avntElement
Call UpdDelKeyControls(mlngDelDCID)
Call modPublic.HourGlassState(False)
End If
SysCmd acSysCmdClearStatus
Else
Call modPublic.ShowMsgBox("Es wurden keine zu löschenden Keys ausgewählt!", _
modPublDecl.gconOkExcStyle, _
conDelSelKeys, _
True)
End If
.SetFocus
End With
cmdDeleteSelected_Click_Exit:
SysCmd acSysCmdRemoveMeter
Exit Sub
cmdDeleteSelected_Click_Err:
Call modPublic.ShowMsgBox(Err.Description, _
modPublDecl.gconOkExcStyle, _
conDelSelKeys, _
True)
Resume cmdDeleteSelected_Click_Exit
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: cmdDeleteAllKeys_Click
'
' Beschreibung: Löscht alle Keys aus der Tabelle tblDB2DMCMDCTablesKeyDelete.
'
' Parameter: Ohne
'-------------------------------------------------------------------------------------'
Private Sub cmdDeleteAllKeys_Click()
On Error GoTo cmdDeleteAllKeys_Click_Err
Const conDelAllKeys As String = "Alle Keys löschen"
Dim strSQL As String
Dim strDelDCID As String
Dim strDelTabelle As String
Dim strDelKey As String
Dim strSubMsg As String
With Me
strDelDCID = IIf(.cboDelDCID.Value = modPublDecl.gconSelectAll, _
"*", _
.cboDelDCID)
strSubMsg = Space(8) & "DCID:" & vbTab & vbTab & _
IIf(strDelDCID = "*", "Alle", .cboDelDCID) & vbCrLf
strDelTabelle = IIf(.cboDelTabelle.Value = modPublDecl.gconSelectAll, _
"*", _
.cboDelTabelle)
strSubMsg = strSubMsg & Space(8) & "Tabelle(n):" & vbTab & _
IIf(strDelTabelle = "*", "Alle", .cboDelTabelle) & vbCrLf
strDelKey = IIf(.cboDelKey.Value = modPublDecl.gconSelectAll, _
"*", _
.cboDelKey)
strSubMsg = strSubMsg & Space(8) & "Key(s):" & vbTab & _
IIf(strDelKey = "*", "Alle", .cboDelKey) & vbCrLf
If modPublic.ShowMsgBox(mconV & mconKeyDel & vbCrLf & strSubMsg & "löschen?", _
modPublDecl.gconYNDef2QuestStyle, _
conDelAllKeys, _
False) = vbYes Then
mboolDeleteAllKeys = True
Call modPublic.SetStatusBarText(9, _
False, _
0)
With .cboDelDCID
strDelDCID = IIf(.Value = modPublDecl.gconSelectAll, _
"*", _
.Value)
End With
With .cboDelTabelle
strDelTabelle = IIf(.Value = modPublDecl.gconSelectAll, _
"*", _
.Value)
End With
With .cboDelKey
strDelKey = IIf(.Value = modPublDecl.gconSelectAll, _
"*", _
.Value)
End With
strSQL = modSQL.QDelAllKeys(CLng(.lstKeyDel.Column(0, 1)), _
strDelDCID, _
strDelTabelle, _
strDelKey)
CurrentDb.Execute strSQL
Call UpdDelKeyControls(mlngDelDCID)
.lstKey.SetFocus
Call lstKeyDelRefresh
End If
End With
cmdDeleteAllKeys_Click_Exit:
SysCmd acSysCmdRemoveMeter
Exit Sub
cmdDeleteAllKeys_Click_Err:
Call modPublic.ShowMsgBox(Err.Description, _
modPublDecl.gconOkExcStyle, _
conDelAllKeys, _
True)
Resume cmdDeleteAllKeys_Click_Exit
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: lstKeyDelRefresh
'
' Beschreibung: Aktualisert das Steuerelement lstKeyDel.
'
' Parameter: Ohne
'-------------------------------------------------------------------------------------'
Private Sub lstKeyDelRefresh()
Dim strSQL As String
Dim strDCIDColl As String
Dim strDelTabelle As String
Dim strDelKey As String
With Me
If Not IsNull(.cboDelDCID) Then
strDCIDColl = BuildSQLInStatement()
If Not IsNull(.cboDelTabelle) Then
With .cboDelTabelle
strDelTabelle = IIf(.Value = modPublDecl.gconSelectAll, _
"*", _
.Value)
End With
If Not IsNull(.cboDelKey) Then
With .cboDelKey
strDelKey = IIf(.Value = modPublDecl.gconSelectAll, _
"*", _
.Value)
End With
strSQL = modSQL.QSelDCTablesKeyDel(mlngDCID, _
strDCIDColl, _
strDelTabelle, _
strDelKey)
.lstKeyDel.RowSource = strSQL
.lstKeyDel.Requery
End If
End If
ElseIf IsNull(.cboDelDCID) Then
.lstKeyDel.RowSource = vbNullString
.cboDelKey.Enabled = False
End If
Call DelKeyRefresh
End With
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: DisableCmdButtons
'
' Beschreibung: Deaktiviert die Befehlsschaltflächen cmdAddSelected, cmdAddAllKeys
' und cmdDeleteAllKeys.
'
' Parameter: Ohne
'-------------------------------------------------------------------------------------'
Private Sub DisableCmdButtons()
With Me
Call EnDisableCtl(.cmdAddAllKeys, _
.cmdAddSelected, _
False)
Call EnDisableCtl(.cmdDeleteAllKeys, _
.cmdDeleteSelected, _
False)
End With
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: EnDisableCmdButtons
'
' Beschreibung: Steuert die Anzeige der Befehlsschaltflächen cmdAddAllKeys/cmdAddSelected
' und cmdDeleteAllKeys/cmdDeleteSelected.
'
' Parameter: Ohne
'-------------------------------------------------------------------------------------'
Private Sub EnDisableCmdButtons()
With Me
If .lstKey.ListCount > 1 Then
If Len(.cboTabelle.Value) <> 0 Then
With Me
Call EnDisableCtl(.cmdAddAllKeys, _
.cmdAddSelected, _
True)
End With
End If
Else
Call EnDisableCtl(.cmdAddAllKeys, _
.cmdAddSelected, _
False)
End If
If .lstKeyDel.ListCount > 1 Then
Call EnDisableCtl(.cmdDeleteAllKeys, _
.cmdDeleteSelected, _
True)
Else
Call EnDisableCtl(.cmdDeleteAllKeys, _
.cmdDeleteSelected, _
False)
End If
End With
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: EnDisableCtl
'
' Beschreibung: Aktiviert bzw. deaktiviert die Steuerelemente Befehlsschaltflächen
' ctlControl1 und ctlControl2.
'
' Parameter: ctlControl1
' ctlControl2
' boolEnabled
'-------------------------------------------------------------------------------------'
Private Sub EnDisableCtl(ByVal ctlControl1 As Control, _
ByVal ctlControl2 As Control, _
ByVal boolEnabled As Boolean)
ctlControl1.Enabled = boolEnabled
ctlControl2.Enabled = boolEnabled
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: cmdClose_Click
'
' Beschreibung: Ruft die Funktion modPublic.CloseForm auf.
'
' Parameter: Ohne
'-------------------------------------------------------------------------------------'
Private Sub cmdClose_Click()
Call modPublic.CloseForm(Me.Name)
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: KeyRefresh
'
' Beschreibung: Aktualisert das Bezeichnungsfeld lblKey und ruft die Prozedur
' EnDisableCmdButtons auf.
'
' Parameter: Ohne
'-------------------------------------------------------------------------------------'
Private Sub KeyRefresh()
With Me
If .lstKey.ListCount > 1 Then
.lblKey.Caption = mconKeyAvail & ": " & .lstKey.ListCount - 1
Else
.cboDCID.SetFocus
.lblKey.Caption = mconKeyAvail & ": 0"
End If
End With
Call EnDisableCmdButtons
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: DelKeyRefresh
'
' Beschreibung: Aktualisert das Bezeichnungsfeld lblKeyDel und aktiviert/deaktiviert
' Steuerelemente abhängig vom Listenzähler.
'
' Parameter: Ohne
'-------------------------------------------------------------------------------------'
Private Sub DelKeyRefresh()
With Me
.cboDCID.SetFocus
If .lstKeyDel.ListCount > 1 Then
.lblKeyDel.Caption = mconV & mconKeyDel & ": " & .lstKeyDel.ListCount - 1
.lstKeyDel.Enabled = True
.lblDelDCID.ForeColor = 0
.cboDelDCID.Enabled = True
.lblDelTabelle.ForeColor = 0
.cboDelTabelle.Enabled = True
.lblDelKey.ForeColor = 0
.cboDelKey.Enabled = True
.cboDelDCID.SetFocus
Else
.lblKeyDel.Caption = mconV & mconKeyDel & ": 0)"
.lstKeyDel.Enabled = False
.lblDelDCID.ForeColor = modPublDecl.gconForeColor
With .cboDelDCID
.Value = vbNullString
.Enabled = False
End With
.lblDelTabelle.ForeColor = modPublDecl.gconForeColor
With .cboDelTabelle
.Value = vbNullString
.Enabled = False
End With
.lblDelKey.ForeColor = modPublDecl.gconForeColor
With .cboDelKey
.Value = vbNullString
.Enabled = False
End With
End If
End With
Call EnDisableCmdButtons
End Sub
'-------------------------------------------------------------------------------------'
' Funktion: KeysSaved
'
' Beschreibung: Prüft, ob gesicherte Keys vorhanden sind und übergibt durch Sprung auf
' den letzten Datensatz den Maxwert von DCID.
'
' Parameter: lngDCID
' rlngMaxDelDCID
'
' Rückgabe: rlngMaxDelDCID
' KeysSaved
'-------------------------------------------------------------------------------------'
Private Function KeysSaved(ByVal lngDCID As Long, _
ByRef rlngMaxDelDCID As Long) As Boolean
Dim dbDAO As DAO.Database
Dim rstDAO As DAO.Recordset
Dim strSQL As String
strSQL = modSQL.QSelDistTablesKeyDel(lngDCID)
Set dbDAO = CurrentDb()
Set rstDAO = dbDAO.OpenRecordset(strSQL, _
dbOpenDynaset)
With rstDAO
If Not .EOF Then
.MoveLast
KeysSaved = True
rlngMaxDelDCID = !DelDCID
ElseIf .EOF Then
KeysSaved = False
rlngMaxDelDCID = 0
End If
.Close
End With
Set dbDAO = Nothing
Set rstDAO = Nothing
End Function
'-------------------------------------------------------------------------------------'
' Prozedur: UpdDelKeyControls
'
' Beschreibung: Aktualisiert die Steuerelemente der zu löschenden Keys.
'
' Parameter: lngDCID
'-------------------------------------------------------------------------------------'
Private Sub UpdDelKeyControls(ByVal lngDCID As Long)
Call modPublic.SetStatusBarText(19, _
False, _
0)
Call cboDelDCIDRefresh(True, lngDCID)
Call cboDelTabelleRefresh(True)
Call cboDelKeyRefresh(True)
Call lstKeyDelRefresh
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: lstKeyRequery
'
' Beschreibung: Aktualisiert das Steuerelement lstKey.
'
' Parameter: strSQL
'-------------------------------------------------------------------------------------'
Private Sub lstKeyRequery(ByVal strSQL As String)
With Me.lstKey
.RowSource = strSQL
.Requery
End With
End Sub
'-------------------------------------------------------------------------------------'
' Prozedur: lstKeyDelRequery
'
' Beschreibung: Aktualisiert das Steuerelement lstKeyDel.
'
' Parameter: strSQL
'-------------------------------------------------------------------------------------'
Private Sub lstKeyDelRequery(ByVal strSQL As String)
With Me.lstKeyDel
.RowSource = strSQL
.Requery
End With
End Sub
'-------------------------------------------------------------------------------------'
' Funktion: BuildSQLInStatement
'
' Beschreibung: Baut den Parameter des SQL In Statements auf.
'
' Parameter: Ohne
'
' Rückgabe: BuildSQLInStatement
'-------------------------------------------------------------------------------------'
Private Function BuildSQLInStatement() As String
Dim intCnt As Integer
With Me.cboDelDCID
If .Value = modPublDecl.gconSelectAll Then
For intCnt = 1 To .ListCount
BuildSQLInStatement = BuildSQLInStatement & .ItemData(intCnt)
If intCnt + 1 < .ListCount Then
BuildSQLInStatement = BuildSQLInStatement & ","
End If
Next intCnt
ElseIf .Value <> modPublDecl.gconSelectAll Then
BuildSQLInStatement = .Value
End If
End With
End Function
'-------------------------------------------------------------------------------------'
' Prozedur: UpdDelDCID
'
' Beschreibung: Aktualisiert die Tabelle tblDB2DMCMDCTablesKeyDelete.
'
' Parameter: rstDAO
' strDCID
' strDelDCID
' strTable
' strKeyVal
'-------------------------------------------------------------------------------------'
Private Sub UpdDelDCID(ByVal rstDAO As Recordset, _
ByVal strDCID As String, _
ByVal strDelDCID As String, _
ByVal strTable As String, _
ByVal strKeyVal As String)
With rstDAO
.AddNew
!DCID = strDCID
!DelDCID = strDelDCID
!Tabelle = strTable
!DB2KeyVal = strKeyVal
.Update
End With
End Sub
