Excel Absturz | Userfrom
05.01.2021 13:22:17
Bernd
ich habe eine Userform in der ich mit einem Scanner Daten eingeben.
Zuvor prüfe ich ob die richtige Sachnummer gescannt wurde und ob der Barcode (Sachnummer+Index) schon mal gesannt wurden.
Das Markro funktioniert auch soweit.
Leider stürtzt Excel unregelmäßig bei der Scannung ab.
Habt ihr vielleicht eine Iddee an was es liegen kann oder ob im Code was steckt was Problem bereitet?
Danke Euch
CODE UserForm1:
Private Sub tbox_ItemNumber_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As _
Integer)
ActiveSheet.Protect UserInterfaceOnly:=True, Password:="16051"
If KeyCode = vbKeyReturn Then
getCode = Left(tbox_ItemNumber.Text, 10)
Set st = Tabelle1
Set ot = Tabelle2
getValid = True
If st.Cells(2, 1).Text getCode Then
getValid = False
tbox_ItemNumber.Text = ""
Me.tbox_ItemNumber.SetFocus
Call WAVBAD
UserForm2.Show
End If
If getValid Then
If WorksheetFunction.CountIf(ot.Columns(2), tbox_ItemNumber.Text) > 0 Then
getValid = False
'MsgBox "FEHLER | Der Artikel wurde bereits eingescannt und verpackt!", _
vbCritical
tbox_ItemNumber.Text = ""
Me.tbox_ItemNumber.SetFocus
Call WAVBAD
UserForm3.Show
Else
Call WAVGOOD
ActiveWorkbook.Save
End If
End If
If getValid Then
nRow = ot.Range("A" & Rows.Count).End(xlUp).Row + 1
ot.Cells(nRow, 1) = st.Cells(2, 1).Text
ot.Cells(nRow, 2) = Me.tbox_ItemNumber.Text
ot.Cells(nRow, 3) = Now
ot.Cells(nRow, 4) = st.Cells(2, 2).Text
If st.Cells(2, 3).Value = st.Cells(2, 4).Value Then
UserForm5.Show
Application.DisplayAlerts = False
Application.ScreenUpdating = False
ot.Copy
ActiveWorkbook.SaveAs ThisWorkbook.Path & "/" & st.Cells(2, 2).Text & "_" & _
Format(Date, "dd-mm-yyyy") & ".xlsx"
ActiveWorkbook.Close , False
Application.ScreenUpdating = True
Application.DisplayAlerts = True
If MsgBox("Maximale Anzahl Artikel verpackt. Datei wurde erfolgreich _
gespeichert.") = vbOK Then
Call druckmat
ot.Range("A2:D" & Rows.Count).ClearContents
End
End If
Else
Unload Me
UserForm1.Show
End If
End If
End If
If KeyCode = vbKeyEscape Then
End
End If
End Sub
