AW: Userform Datensatz löschen
19.12.2021 19:14:13
Richard
Option Explicit
Private arrData As Variant
Private wksData As Worksheet
Private arrList As Variant
'Wie viele TextBoxen sind auf der UserForm platziert?
Private Const iCONST_ANZAHL_EINGABEFELDER As Integer = 22
'In welcher Zeile starten die Eingaben?
Private Const lCONST_STARTZEILENNUMMER_DER_TABELLE As Long = 2
Private Sub UserForm_Initialize()
Dim Zeile_L As Long
Dim lngZeile As Long
' Dim InZeile As Integer
cmbArchiv.RowSource = "'tblGrunddaten'!A2:A4"
cmbErhaltung.RowSource = "'tblGrunddaten'!B2:B7"
cmbBearbeiter.RowSource = "'tblGrunddaten'!C2:C3"
cmbDigiDok.RowSource = "'tblGrunddaten'!D2:D3"
cmbDigiDokPfad.RowSource = "'tblGrunddaten'!E2:E3"
'Tabellenblatt mit den Daten einer modulweiten Variablen zuweisen
Set wksData = ThisWorkbook.Sheets("tblUrkunden")
With wksData
Zeile_L = .Cells(.Rows.Count, 1).End(xlUp).Row 'letzte Zeile mit Daten in Spalte A des Tabellenblatts
'Daten (Spalten A:L) im Tabellenblatt in ein Daten-Array übernehmen ohne Spaltentitel _
und miteiner Leerspalte für die Zeilennummer
arrData = .Range(.Cells(2, 1), .Cells(Zeile_L, 22))
End With
'Listbox formatieren
With Me.lst1
.ColumnCount = 16
.ColumnHeads = False
.ColumnWidths = "100Pt;50Pt;0Pt;50Pt;190Pt;"
End With
Call Auswahl_Reset
End Sub
Private Sub AuswahlListeSignatur()
'Auswalliste für Signatur aktualisieren
Dim hshA As Object
Dim i As Long
Dim varJahr
Set hshA = CreateObject("Scripting.Dictionary")
varJahr = Me.cmbJahr.Text
For i = LBound(arrList) To UBound(arrList)
If (varJahr = "" Or varJahr = arrList(i, 11)) Then hshA(CStr(arrList(i, 2))) = 0
Next
'Auswahlliste der Combobox zuweisen
Me.cmbSignatur.List = hshA.keys
Set hshA = Nothing
End Sub
Sub AuswahlListeJahr()
'Auswalliste für Jahr aktualisieren
Dim hshA As Object
Dim i As Long
Dim varSignatur
Set hshA = CreateObject("Scripting.Dictionary")
varSignatur = Me.cmbSignatur.Text
For i = LBound(arrList) To UBound(arrList)
If (varSignatur = "" Or varSignatur = arrList(i, 2)) Then hshA(CStr(arrList(i, 11))) = 0
' If (varADM = "" Or varADM = arrList(i, 1)) And (varKlinik = "" Or varKlinik = arrList(i, 3)) _
' Then hshA(CStr(arrList(i, 6))) = 0
' End If
Next
'Auswahlliste der Combobox zuweisen
Me.cmbJahr.List = hshA.keys
Set hshA = Nothing
End Sub
Private Sub Auswahl_Reset()
'Auswahl für Comboboxen zurücksetzen
'Listbox formatieren und alle Daten zuweisen
arrList = arrData
With Me.lst1
.Clear
.List = arrList
.ListIndex = 0
End With
Me.cmbSignatur.ListIndex = -1
Me.cmbJahr.ListIndex = -1
Call AuswahlListeSignatur
Call AuswahlListeJahr
End Sub
Private Sub Listbox_fuellen()
'Daten für Listbox zusammenstellen
Dim AnzTreffer As Long
Dim hshA As Object
Dim i As Long
Dim Zeile As Long, Spalte As Long
Dim varSignatur, varJahr, varKey
Set hshA = CreateObject("Scripting.Dictionary")
varSignatur = Me.cmbSignatur.Text
varJahr = Me.cmbJahr.Text
AnzTreffer = 0
For i = LBound(arrData, 1) To UBound(arrData, 1)
If (varSignatur = "" Or varSignatur = arrData(i, 2)) Then
If (varJahr = "" Or varJahr = arrData(i, 11)) Then
AnzTreffer = AnzTreffer + 1
hshA(CStr(i)) = 0
End If
End If
Next
Me.lst1.Clear
If AnzTreffer > 0 Then
ReDim arrList(1 To AnzTreffer, LBound(arrData, 2) To UBound(arrData, 2))
AnzTreffer = 0
For Each varKey In hshA.keys
Zeile = Val(varKey)
AnzTreffer = AnzTreffer + 1
For Spalte = LBound(arrData, 2) To UBound(arrData, 2)
arrList(AnzTreffer, Spalte) = arrData(Zeile, Spalte)
Next
Next
With Me.lst1
.List = arrList
.ListIndex = 0
End With
End If
Set hshA = Nothing
End Sub
Private Sub cmbSignatur_Change()
'Signatur wurde ausgewählt
If Me.cmbSignatur.ListIndex = -1 Then Exit Sub
Call Listbox_fuellen
Call AuswahlListeJahr
End Sub
Private Sub cmbJahr_Change()
'Jahr wurde ausgewählt
If Me.cmbJahr.ListIndex = -1 Then Exit Sub
Call Listbox_fuellen
Call AuswahlListeSignatur
End Sub
Private Sub cmdBeenden_Click()
Erase arrList, arrData
Set wksData = Nothing
Unload Me
Sheets("Hauptmenü").Select
End Sub
Private Sub btnloeschen_Click()
Dim lngZeile As Long
Dim JaNein
JaNein = MsgBox("Wollen Sie wirklich löschen", vbYesNo + vbQuestion, "Zeilen weg")
If JaNein = vbNo Then
' MsgBox "nein: wurde gewählt"
Exit Sub
End If
For lngZeile = Me.lst1.ListCount - 1 To 0 Step -1
If Me.lst1.Selected(lngZeile) = True Then
' Sheets("tblUrkunden").Rows(lst1.ListIndex - 1).Delete
Sheets("tblUrkunden").Rows(lngZeile).Delete
Me.lst1.RemoveItem lngZeile
End If
Next lngZeile
End Sub
Private Sub cmdneueAbfrage_Click()
Call Auswahl_Reset
End Sub
Private Sub btnanzeigen_Click()
frmUrkundeändern.cmbArchiv = lst1.List(lst1.ListIndex, 0) 'Archiv
frmUrkundeändern.txtSignatur = lst1.List(lst1.ListIndex, 1) 'Signatur
frmUrkundeändern.txtZähler1 = lst1.List(lst1.ListIndex, 2) 'Zähler1
frmUrkundeändern.txtDatierung = lst1.List(lst1.ListIndex, 3) 'Datierung
frmUrkundeändern.txtKurzregest = lst1.List(lst1.ListIndex, 4) 'Kurzregest
frmUrkundeändern.txtVollregest = lst1.List(lst1.ListIndex, 5) 'Vollregest
frmUrkundeändern.txtQuelle = lst1.List(lst1.ListIndex, 6) 'Quellenangabe
frmUrkundeändern.txtÜbersetzung = lst1.List(lst1.ListIndex, 7) 'Übersetzung
frmUrkundeändern.cmbErhaltung = lst1.List(lst1.ListIndex, 8) 'Erhaltung
frmUrkundeändern.txtKlassifikation = lst1.List(lst1.ListIndex, 9) 'Klassifikation
frmUrkundeändern.txtJahr = lst1.List(lst1.ListIndex, 10) 'Jahr
frmUrkundeändern.txtBemerkung = lst1.List(lst1.ListIndex, 11) 'Bemerkung
frmUrkundeändern.txtPersonen = lst1.List(lst1.ListIndex, 12) 'Personen
frmUrkundeändern.txtOrte = lst1.List(lst1.ListIndex, 13) 'Orte
frmUrkundeändern.txtGebäude = lst1.List(lst1.ListIndex, 14) 'Sachbegriffe
frmUrkundeändern.txtSachbegriffe = lst1.List(lst1.ListIndex, 15) 'Gebäude
frmUrkundeändern.cmbDigiDok = lst1.List(lst1.ListIndex, 16) 'DigDok
frmUrkundeändern.cmbDigiDokPfad = lst1.List(lst1.ListIndex, 17) 'DigiPfad
frmUrkundeändern.txtDigiDokDateiname = lst1.List(lst1.ListIndex, 18) 'DigiDateiname
frmUrkundeändern.txtFoto = lst1.List(lst1.ListIndex, 19) 'Bilder
frmUrkundeändern.txtErfassungsdatum = lst1.List(lst1.ListIndex, 20) 'DatumErfassung
frmUrkundeändern.cmbBearbeiter = lst1.List(lst1.ListIndex, 21) 'Bearbeiter
' frmUrkundeändern.txtKlassifikation = lst1.List(lst1.ListIndex, 10) 'Klassifikation
End Sub
Private Sub btnspeichern_Click() ' Änderung in Tabelle speichern
Dim lngZeile As Long
Dim txt As Object
If lst1.ListIndex >= 0 Then
lngZeile = Me.lst1.ListIndex + 2
Worksheets("tblUrkunden").Cells(lngZeile, 1) = cmbArchiv
Worksheets("tblUrkunden").Cells(lngZeile, 2) = txtSignatur
Worksheets("tblUrkunden").Cells(lngZeile, 3) = txtZähler1
Worksheets("tblUrkunden").Cells(lngZeile, 4) = txtDatierung
Worksheets("tblUrkunden").Cells(lngZeile, 5) = txtKurzregest
Worksheets("tblUrkunden").Cells(lngZeile, 6) = txtVollregest
Worksheets("tblUrkunden").Cells(lngZeile, 7) = txtQuelle
Worksheets("tblUrkunden").Cells(lngZeile, 8) = txtÜbersetzung
Worksheets("tblUrkunden").Cells(lngZeile, 9) = cmbErhaltung
Worksheets("tblUrkunden").Cells(lngZeile, 10) = txtKlassifikation
Worksheets("tblUrkunden").Cells(lngZeile, 11) = txtJahr
Worksheets("tblUrkunden").Cells(lngZeile, 12) = txtBemerkung
Worksheets("tblUrkunden").Cells(lngZeile, 13) = txtPersonen
Worksheets("tblUrkunden").Cells(lngZeile, 14) = txtOrte
Worksheets("tblUrkunden").Cells(lngZeile, 15) = txtGebäude
Worksheets("tblUrkunden").Cells(lngZeile, 16) = txtSachbegriffe
Worksheets("tblUrkunden").Cells(lngZeile, 17) = cmbDigiDok
Worksheets("tblUrkunden").Cells(lngZeile, 18) = cmbDigiDokPfad
Worksheets("tblUrkunden").Cells(lngZeile, 19) = txtDigiDokDateiname
Worksheets("tblUrkunden").Cells(lngZeile, 20) = txtFoto
Worksheets("tblUrkunden").Cells(lngZeile, 21) = txtErfassungsdatum
Worksheets("tblUrkunden").Cells(lngZeile, 22) = cmbBearbeiter
'zurückschreiben in Lst
' lst2.List(lst2.ListIndex, 0) = cbbBundesland 'Bundesland
' lst2.List(lst2.ListIndex, 1) = txt2 'Klinik
Else
MsgBox "Bitte Datensatz markieren im Listenfeld"
For Each txt In Me.Controls
If TypeName(txt) = "TextBox" Then
txt.Value = ""
End If
Next txt
End If
Call UserForm_Initialize
' Frame1.Visible = False
' Frame2.Visible = False
End Sub