VBA unload me und Formular.show anders
27.04.2016 18:36:18
Michael
Das nächste Problem was ich nicht alleine gelöst bekomme ist, dass ich das unload me und dann Formular.show am Ende anders gelöst haben möcht.
Da Franz aus diesem Forum mir schrieb, Zitat: "Das ist nicht ideal, da diese Aktionen in einander geschachtelt werden. Besser ist es in solchen Fällen einen Reset der Steuerelemente durchzuführen (Textfelder leeren, Listboxen/Comboboxen auf Listindex -1 setzen."
Was ich auch bestätigen musste, da ich bei manchen speicherungen den einen oder anderen Laufzeitfehler bekam. nachden ich die Datei dann schloss und wieder öffnete funktionierte alles einwandfrei und die Änderungen waren auch übernommen.
Nur bekomme ich die Lösung nicht alleine hin.
Gruß Michael
'############################### Anderungen Mitarbeiter speichern ###################################################
Private Sub cmdSpeichern_Click()
Dim lZeile As Long
'Wenn kein Datensatz in der ListBox markiert wurde, wird die Routine beendet
If ListBox1.ListIndex = -1 Then Exit Sub
'Wir müssen prüfen, ob die Namen Spalte auch gefüllt ist!!
If Trim(CStr(txtPersonalnummer.Text)) = "" Then
'Meldung ausgeben
MsgBox "Du musst mindestens einen Namen/Personalnummer eingeben!", vbCritical + _
vbOKOnly, "FEHLER!"
'Abbrechen der Speicherroutine
Exit Sub
End If
If MsgBox("Möchtest du die Ändrungen wirklich übernehmen?", vbYesNo) = vbNo Then
Unload Me
FormularMitarbeiter.Show
End If
'Ausbauoption: Prüfen, ob der Name in Tabelle1 Spalte 1 schon vorhanden ist!
'Zum Speichern benötigen wir die Zeilennummer des ausgewählten Datensatzes
lZeile = 2 'Start in Zeile 2, Zeile 1 sind ja die Überschriften
'Schleife solange etwas in der ersten Spalte in Tabelle 1 drin steht
Do While Trim(CStr(Tabelle1.Cells(lZeile, 1).Text)) ""
'Datensatz Name Spalte mit selektiertem Eintrag der ListBox vergleichen
If ListBox1.Text = Trim(CStr(Tabelle1.Cells(lZeile, 1).Text)) Then
'Eintrag gefunden, TextBoxen in die Zellen schreiben
Tabelle1.Cells(lZeile, 1).Value = Trim(CStr(txtPersonalnummer.Text))
Tabelle1.Cells(lZeile, 2).Value = txtVorname.Text
Tabelle1.Cells(lZeile, 3).Value = txtName.Value
Tabelle1.Cells(lZeile, 4).Value = txtGeburtsdatum.Value
Tabelle1.Cells(lZeile, 5).Value = txtEintritt.Value
Tabelle1.Cells(lZeile, 7).Value = txtBeruf.Text
Tabelle1.Cells(lZeile, 8).Value = txtAbteilung.Text
Tabelle1.Cells(lZeile, 9).Value = txtEntgeltgruppe.Value
Tabelle1.Cells(lZeile, 11).Value = txtSchlüsselnummer.Text
Tabelle1.Cells(lZeile, 14).Value = txtLeistungsbeurteilung.Value
Tabelle1.Cells(lZeile, 16).Value = txtKF.Value
Tabelle1.Cells(lZeile, 22).Value = txtKostenstelle.Value
Tabelle1.Cells(lZeile, 23).Value = txtEingruppierung.Value
Tabelle1.Cells(lZeile, 24).Value = txtAnrede.Value
'Die ListBox muss nun neu geladen werden
'allerdings nur, wenn sich der Name geändert hat
If ListBox1.Text Trim(CStr(txtPersonalnummer.Text)) Then
Call UserForm_Initialize
If ListBox1.ListCount > 0 Then ListBox1.ListIndex = 0
End If
Exit Do 'Vorzeitiges Ende, da der Datensatz schon gefunden ist
End If
lZeile = lZeile + 1 'Nächste Zeile bearbeiten
Loop
' Liste neu sortieren
loLetzte = Sheets("Stammdaten").Cells(Rows.Count, 3).End(xlUp).Row
ActiveWorkbook.Worksheets("Stammdaten").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Stammdaten").Sort.SortFields.Add Key:=Range( _
"C1:C" & loLetzte), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Stammdaten").Sort
.SetRange Range("A1:X" & loLetzte)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Application.Goto Reference:=Sheets("Stammdaten").Range("AE1")
With Sheets("Stammdaten")
loKopieren = .Cells(Rows.Count, 2).End(xlUp).Row
.Range(.Cells(2, 2), .Cells(loKopieren, 4)).Copy
Sheets("Geburtstag").Cells(3, 4).PasteSpecial Paste:=xlValues
.Range(.Cells(2, 18), .Cells(loKopieren, 19)).Copy
Sheets("Geburtstag").Cells(3, 7).PasteSpecial Paste:=xlValues
.Range(.Cells(2, 6), .Cells(loKopieren, 6)).Copy
Sheets("Geburtstag").Cells(3, 9).PasteSpecial Paste:=xlValues
.Range(.Cells(2, 20), .Cells(loKopieren, 21)).Copy
Sheets("Geburtstag").Cells(3, 10).PasteSpecial Paste:=xlValues
End With
Application.CutCopyMode = False
ActiveWorkbook.Save
Unload Me
FormularMitarbeiter.Show
End Sub