Public status As String
Sub Einbuchen11()
Dim sp As Long
Dim sachNummer As String
Dim anzahlLT As Integer
Dim Schicht As Long
Dim umgebuchtLT As Integer
Dim Netzwerk As Object
'__________________________________________________________________________________________
'__________________________________________________________________________________________
'__________________________________________________________________________________________
On Error Resume Next
zl = 0
zl = Columns([spGasse]).Find(what:=meinWert, LookAt:=xlWhole).Row
On Error GoTo 0
sp = [spAnzahl-4]
If Cells(1, 10).Value = "-Label" Then '1
Gasse:
If Cells(2, 10).Value = "einbuchen" Then
Dim gasseBarcode As String
zl = 4
gasseBarcode = InputBox("In welche Gasse wird eingebucht?")
If StrPtr(gasseBarcode) = 0 Then
Exit Sub
Else
On Error Resume Next
Do While Cells(zl, 3).Value <> "Ende"
If Cells(zl, 3).Value = gasseBarcode Then
zl = zl
GoTo Mesut:
End If
zl = zl + 1
Loop
End If 'abbrechen
End If
Mesut:
If Cells(2, 10).Value = "einbuchen" Then
sachNummer1:
Rows(zl).Font.Name = "Arial Black"
'_____________________________________________________________________________________Sprung ausführen
Cells(zl, sp + 1).Select
sachNummer = InputBox("Scannen Sie die gewünschten Sachnummer", "Welche Sachnummer soll zustäzlich eingebucht werden?")
sachNummer = Left(sachNummer, 17)
Stückzahl = Right(sachNummer, 2)
If StrPtr(sachNummer) = 0 Then
Rows(zl).Font.Name = "Arial"
Exit Sub
Else
Select Case sachNummer:
Case "R2312710300":
sachNummer = "R 231 271 03 00"
Case "A2056164301 5100":
sachNummer = "A 205 616 43 01 5100"
End Select
Cells(3, 10).Value = sachNummer
If Cells(2, 11).Value = 0 Then
If Cells(zl, 5).Value = sachNummer And Cells(zl, 3).Value = gasseBarcode Then
Cells(2, 11).Value = 0.1
GoTo Nad1:
End If
zl = zl + 1
If Cells(zl, 5).Value = sachNummer And Cells(zl, 3).Value = gasseBarcode Then
Cells(2, 11).Value = 0.2
GoTo Nad1:
End If
zl = zl + 1
If Cells(zl, 5).Value = sachNummer And Cells(zl, 3).Value = gasseBarcode Then
Cells(2, 11).Value = 0.3
GoTo Nad1:
End If
MsgBox ("Diese Sachnummer ist nicht in der Gasse vorhanden")
GoTo Ende1:
End If
End If
End If
If Cells(2, 10).Value = "einbuchen" Then
Nad1:
Cells(zl, sp + 2).Select
STATIS.Show
Select Case status:
Case "1":
status = "frei"
Case "2":
status = "ungestanzt/NA"
Case "3":
status = "gesperrt"
Case "4":
status = "imprägnieren"
Case "5":
status = "Probe / Muster - Versuch"
End Select
If ((Cells(zl, sp + 1).Value = sachNummer) And (Cells(zl, sp + 2).Value = status)) Then
GoTo wini:
End If
If ((Cells(zl, sp + 1).Value = sachNummer) And (Cells(zl, sp + 2).Value <> status)) Then
If Cells(2, 11).Value = 0.1 Then
Cells(2, 11).Value = 0.12
zl = zl + 1
GoTo a:
End If
If Cells(2, 11).Value = 0.2 Then
Cells(2, 11).Value = 0.23
zl = zl + 1
GoTo b:
End If
If Cells(2, 11).Value = 0.3 Then
Cells(2, 11).Value = 0.32
zl = zl - 1
GoTo c:
End If
End If
If Cells(2, 10).Value = "einbuchen" Then
sachNummer2:
Rows(zl).Font.Name = "Arial Black"
'---------------------------------------------------Sprung ausführen
Cells(zl, sp + 1).Select
sachNummer = InputBox("Scannen Sie die gewünschten Sachnummer", "Welche Sachnummer soll eingebucht werden?")
sachNummerLi = Left(sachNummer, 17)
Stückzahl = Right(sachNummer, 2)
If StrPtr(sachNummer) = 0 Then
Exit Sub
Else
Select Case sachNummerLi:
Case "R2312710300":
sachNummer = "R 231 271 03 00"
Case "R1570103600 5710":
sachNummer = "R 157 010 36 00 5710"
End Select
Cells(3, 10).Value = sachNummer
If Cells(2, 11).Value = 3 Then
zl = zl - 2
If ((Cells(zl, 5).Value = sachNummer) And (Cells(zl, 3).Value = gasseBarcode)) Then
Cells(2, 11).Value = 3.1
GoTo Nad:
End If
zl = zl + 1
If ((Cells(zl, 5).Value = sachNummer) And (Cells(zl, 3).Value = gasseBarcode)) Then
Cells(2, 11).Value = 3.2
GoTo Nad:
End If
zl = zl + 1
GoTo Fall1:
End If
If Cells(2, 11).Value = 2 Then
zl = zl - 1
If ((Cells(zl, 5).Value = sachNummer) And (Cells(zl, 3).Value = gasseBarcode)) Then
Cells(2, 11).Value = 2.1
GoTo Nad:
End If
zl = zl + 2
If ((Cells(zl, 5).Value = sachNummer) And (Cells(zl, 3).Value = gasseBarcode)) Then
Cells(2, 11).Value = 2.3
GoTo Nad:
End If
zl = zl - 1
GoTo Fall1:
End If
If Cells(2, 11).Value = 1 Then
zl = zl + 1
If ((Cells(zl, 5).Value = sachNummer) And (Cells(zl, 3).Value = gasseBarcode)) Then
Cells(2, 11).Value = 1.2
GoTo Nad:
End If
zl = zl + 1
If ((Cells(zl, 5).Value = sachNummer) And (Cells(zl, 3).Value = gasseBarcode)) Then
Cells(2, 11).Value = 1.3
GoTo Nad:
End If
zl = zl - 2
GoTo Fall1:
End If
End If
End If
If Cells(2, 10).Value = "einbuchen" Then
Nad:
Cells(zl, sp + 2).Select
STATIS.Show
Select Case status:
Case "1":
status = "frei"
Case "2":
status = "ungestanzt/NA"
Case "3":
status = "gesperrt"
Case "4":
status = "imprägnieren"
Case "5":
status = "Probe / Muster - Versuch"
End Select
If ((Cells(zl, sp + 1).Value = sachNummer) And (Cells(zl, sp + 2).Value = status)) Then
GoTo wini:
End If
If ((Cells(zl, sp + 1).Value = sachNummer) And (Cells(zl, sp + 2).Value <> status)) Then
If Cells(2, 11).Value = 1.2 Then
Cells(2, 11).Value = 1.23
zl = zl + 1
GoTo 11:
End If
If Cells(2, 11).Value = 1.3 Then
zl = zl - 2
Call Einbuchen22
End If
If Cells(2, 11).Value = 2.1 Then
Cells(2, 11).Value = 2.13
zl = zl + 2
GoTo 22:
End If
If Cells(2, 11).Value = 2.3 Then
zl = zl - 1
Call Einbuchen22
End If
If Cells(2, 11).Value = 3.1 Then
Cells(2, 11).Value = 3.12
zl = zl + 1
GoTo 33:
End If
If Cells(2, 11).Value = 3.2 Then
zl = zl + 1
Call Einbuchen22
End If
End If
End If
End Sub
Ausschnitt. des ganzen.
|