Hängt sich bei Speicherung auf
23.06.2022 10:02:56
Max
ich hatte gestern folgendes Problem, das mir die liebe Karin lösen konnte: Ich will eine Fehlermeldung anzeigen, wenn die Eingabe einer gleichen Kundennummer mit dem gleichen Datum abgespeichert werden soll. Dieses Problem konnte soweit gelöst werden. Ich weiß leider beim besten Willen nicht warum, aber wenn ich jetzt abspeichern will, dann hängt sich Excel jedes Mal auf, was vorher nie passiert ist.
Kann mir da vielleicht jemand helfen?
Der Code:
Private Sub Button5_DatensatzErfassen_Click()
Dim rZelle As Range
Dim strStart As String
Dim last As Long
Set wksh = ThisWorkbook.Worksheets("Maschine 1")
If TextBox5.Value "" Then
With wksh
Set rZelle = .Columns(4).Find(TextBox5.Value, Lookat:=xlWhole, LookIn:=xlValues)
If Not rZelle Is Nothing Then
strStart = rZelle.Address
Do
If rZelle.Offset(0, -3) CDate(Datum) Then
Set rZelle = wksh.Columns(4).FindNext(rZelle)
Else
If MsgBox("Die Kundennummer ist bereits vergeben! Bitte geben Sie diese erneut ein.", vbExclamation + vbOKOnly) = vbOK Then
TextBox5.SetFocus
Exit Sub
End If
End If
Loop While rZelle.Address = strStart
End If
If MsgBox("Möchten Sie Ihre Eingaben speichern?", vbYesNo + vbQuestion) = vbYes Then
last = .Cells(Rows.Count, 1).End(xlUp).Row + 1
.Cells(last, 1).Value = UserForm2.Datum.Value
.Cells(last, 2).Value = UserForm2.TextBox1.Value
.Cells(last, 3).Value = UserForm2.ComboBoxFirma1_Maschine.Value
.Cells(last, 4).Value = UserForm2.TextBox5.Value
.Cells(last, 6).Value = UserForm2.TextBox10.Value
.Cells(last, 7).Value = UserForm2.TextBox11.Value
.Cells(last, 8).Value = UserForm2.TextBox12.Value
.Cells(last, 9).Value = UserForm2.TextBox13.Value
.Cells(last, 10).Value = UserForm2.TextBox14.Value
.Cells(last, 11).Value = UserForm2.TextBox15.Value
.Cells(last, 12).Value = UserForm2.TextBox16.Value
.Cells(last, 13).Value = UserForm2.TextBox17.Value
.Cells(last, 14).Value = UserForm2.TextBox18.Value
End If
End With
End If
End Sub
Meine Beispieldatei: https://www.herber.de/bbs/user/153730.xlsm
Wie immer vielen Dank für Eure tatkräftige Unterstützung!
Mit vielen Grüßen
Max