Option Explicit
Private Sub CommandButton6_Click()
Unload UserForm1
End Sub
Private Sub Image1_Click()
End Sub
Private Sub Label9_Click()
End Sub
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
TextBox1.Value = ListBox1.List(Me.ListBox1.ListIndex, 0)
TextBox2.Value = ListBox1.List(Me.ListBox1.ListIndex, 1)
TextBox3.Value = ListBox1.List(Me.ListBox1.ListIndex, 2)
TextBox4.Value = ListBox1.List(Me.ListBox1.ListIndex, 3)
TextBox5.Value = ListBox1.List(Me.ListBox1.ListIndex, 4)
TextBox6.Value = ListBox1.List(Me.ListBox1.ListIndex, 5)
TextBox7.Value = ListBox1.List(Me.ListBox1.ListIndex, 6)
TextBox8.Value = ListBox1.List(Me.ListBox1.ListIndex, 7)
FundZeile = ListBox1.List(Me.ListBox1.ListIndex, 7)
CommandButton3.Enabled = True
CommandButton4.Enabled = True
End Sub
Private Sub CommandButton1_Click()
Dim lLetzte As String
Dim iIndex As Integer
If TextBox1.Value = "" Then
MsgBox "Sie müssen eine Artikelnummer eingeben - danke.", _
48, " Hinweis für " & Application.UserName
TextBox1.SetFocus
Exit Sub
End If
If TextBox2.Value = "" Then
MsgBox "Sie müssen einen Artikelnamen eingeben - danke.", _
48, " Hinweis für " & Application.UserName
TextBox2.SetFocus
Exit Sub
End If
If TextBox3.Value = "" Then
MsgBox "Sie müssen einen Artikelhersteller eingeben - danke.", _
48, " Hinweis für " & Application.UserName
TextBox3.SetFocus
Exit Sub
End If
If TextBox4.Value = "" Then
MsgBox "Sie müssen ein Regal eingeben - danke.", _
48, " Hinweis für " & Application.UserName
TextBox4.SetFocus
Exit Sub
End If
If TextBox5.Value = "" Then
MsgBox "Sie müssen ein Segment eingeben - danke.", _
48, " Hinweis für " & Application.UserName
TextBox5.SetFocus
Exit Sub
End If
If TextBox7.Value = "" Then
MsgBox "Sie müssen eine Ebene eingeben - danke.", _
48, " Hinweis für " & Application.UserName
TextBox7.SetFocus
Exit Sub
End If
If TextBox8.Value = "" Then
MsgBox "Sie müssen einen Einkaufspreis eingeben - danke.", _
48, " Hinweis für " & Application.UserName
TextBox8.SetFocus
Exit Sub
End If
Application.ScreenUpdating = False
With Worksheets("Tabelle1")
.Unprotect Password:="Geheim"
lLetzte = IIf(.Range("A65536") <> "", 65536, .Range("A65536").End(xlUp).Row) + 1
If lLetzte < 2 Then lLetzte = 2
.Range("A" & lLetzte).Value = WorksheetFunction.Proper(TextBox1.Value)
.Range("B" & lLetzte).Value = WorksheetFunction.Proper(TextBox2.Value)
.Range("C" & lLetzte).Value = WorksheetFunction.Proper(TextBox3.Value)
.Range("D" & lLetzte).Value = WorksheetFunction.Proper(TextBox4.Value)
.Range("E" & lLetzte).Value = WorksheetFunction.Proper(TextBox5.Value)
.Range("F" & lLetzte).Value = WorksheetFunction.Proper(TextBox6.Value)
.Range("G" & lLetzte).Value = WorksheetFunction.Proper(TextBox7.Value)
.Range("H" & lLetzte).Value = WorksheetFunction.Proper(TextBox8.Value)
.Range(.Cells(1, 1), .Cells(lLetzte, 8)).Sort _
Key1:=.Cells(1, 1), Order1:=xlAscending, _
Key2:=.Cells(1, 2), Order2:=xlAscending, _
Key3:=.Cells(1, 4), Order3:=xlAscending, _
Header:=xlGuess
.Columns("A:H").EntireColumn.AutoFit
Call Zeilen_faerben
With ListBox1
Call Array_fuellen
.Clear
.Column = aTmp
End With
Label8.Caption = "Anzahl Datensätze: " & (lLetzte - 1)
.Protect Password:="Geheim"
End With
For iIndex = 1 To 8
With Controls("TextBox" & iIndex)
.Value = ""
End With
Next iIndex
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton5_Click()
Dim iIndex As Integer
For iIndex = 1 To 8
With Controls("TextBox" & iIndex)
.Value = ""
End With
Next iIndex
CommandButton3.Enabled = False
CommandButton4.Enabled = False
End Sub
Private Sub CommandButton2_Click()
Dim WkSh As Worksheet
Dim lLetzte As String
Dim myRange As Range
Dim strAddress As String
Dim bolAbbruch As Boolean
CommandButton3.Enabled = False
CommandButton4.Enabled = False
Set WkSh = Worksheets("Tabelle1")
lLetzte = WkSh.Range("A65536").End(xlUp).Row
If lLetzte < 2 Then lLetzte = 2
If TextBox1.Value = "" Then
MsgBox "Es fehlt ein Suchbegriff in der TextBox1 - Abbruch", _
48, " Hinweis für " & Application.UserName
TextBox1.SetFocus
Exit Sub
Else
TextBox1.Value = WorksheetFunction.Proper(TextBox1.Value)
With WkSh
Set myRange = .Columns(1).Find(What:=UserForm1.TextBox1.Value, _
LookIn:=xlValues, LookAt:=xlPart, After:=.Cells(Rows.Count, 1))
If Not myRange Is Nothing Then
strAddress = myRange.Address
myRange.Activate
FundZeile = ActiveCell.Row
GoSub Anzeigen
Do
If MsgBox("Weitersuchen?", 36, " Abfrage") = vbNo Then
bolAbbruch = True
Exit Sub
Else
Set myRange = .Columns(1).FindNext(myRange)
If myRange.Address <> strAddress Then
myRange.Activate
FundZeile = ActiveCell.Row
GoSub Anzeigen
End If
End If
Loop While Not myRange Is Nothing And myRange.Address <> strAddress
If Not bolAbbruch Then
MsgBox "Keine weiteren Datensätze gefunden.", _
48, " Information für " & Application.UserName
FundZeile = 0
Else
MsgBox "Keinen übereinstimmenden Datensatz gefunden", _
48, " Information für " & Application.UserName
FundZeile = 0
End If
Else
MsgBox "Keinen übereinstimmenden Datensatz gefunden", _
48, " Information für " & Application.UserName
FundZeile = 0
With TextBox2
.SetFocus
.SelStart = 0
.SelLength = Len(.Text)
End With
End If
End With
End If
CommandButton3.Enabled = False
CommandButton4.Enabled = False
Exit Sub
Anzeigen:
If FundZeile = 0 Then Exit Sub
TextBox1.Value = ActiveCell.Offset(0, 0).Value
TextBox2.Value = ActiveCell.Offset(0, 1).Value
TextBox3.Value = ActiveCell.Offset(0, 2).Value
TextBox4.Value = ActiveCell.Offset(0, 3).Value
TextBox5.Value = ActiveCell.Offset(0, 4).Value
TextBox6.Value = ActiveCell.Offset(0, 5).Value
TextBox7.Value = ActiveCell.Offset(0, 6).Value
TextBox8.Value = ActiveCell.Offset(0, 7).Value
CommandButton3.Enabled = True
CommandButton4.Enabled = True
Return
End Sub
Private Sub CommandButton3_Click()
Dim lLetzte As Currency
If TextBox1.Value = "" Then
MsgBox "Sie müssen eine Artikelnummer eingeben - danke.", _
48, " Hinweis für " & Application.UserName
TextBox1.SetFocus
Exit Sub
End If
If TextBox2.Value = "" Then
MsgBox "Sie müssen einen Artikelnamen eingeben - danke.", _
48, " Hinweis für " & Application.UserName
TextBox2.SetFocus
Exit Sub
End If
If TextBox3.Value = "" Then
MsgBox "Sie müssen einen Artikelhersteller eingeben - danke.", _
48, " Hinweis für " & Application.UserName
TextBox3.SetFocus
Exit Sub
End If
If TextBox4.Value = "" Then
MsgBox "Sie müssen ein Regal eingeben - danke.", _
48, " Hinweis für " & Application.UserName
TextBox4.SetFocus
Exit Sub
End If
If TextBox5.Value = "" Then
MsgBox "Sie müssen ein Segment eingeben - danke.", _
48, " Hinweis für " & Application.UserName
TextBox5.SetFocus
Exit Sub
End If
If TextBox6.Value = "" Then
MsgBox "Sie müssen eine Ebene eingeben - danke.", _
48, " Hinweis für " & Application.UserName
TextBox6.SetFocus
Exit Sub
End If
If TextBox7.Value = "" Then
MsgBox "Sie müssen eine Anzahl eingeben - danke.", _
48, " Hinweis für " & Application.UserName
TextBox7.SetFocus
Exit Sub
End If
If TextBox8.Value = "" Then
MsgBox "Sie müssen einen Artikelpreis eingeben - danke.", _
48, " Hinweis für " & Application.UserName
TextBox8.SetFocus
Exit Sub
End If
Application.ScreenUpdating = False
With Worksheets("Tabelle1")
.Unprotect Password:="Geheim"
.Range("A" & FundZeile).Value = WorksheetFunction.Proper(TextBox1.Value)
.Range("B" & FundZeile).Value = WorksheetFunction.Proper(TextBox2.Value)
.Range("C" & FundZeile).Value = WorksheetFunction.Proper(TextBox3.Value)
.Range("D" & FundZeile).Value = WorksheetFunction.Proper(TextBox4.Value)
.Range("E" & FundZeile).Value = WorksheetFunction.Proper(TextBox5.Value)
.Range("F" & FundZeile).Value = WorksheetFunction.Proper(TextBox6.Value)
.Range("G" & FundZeile).Value = WorksheetFunction.Proper(TextBox7.Value)
.Range("H" & FundZeile).Value = WorksheetFunction.Proper(TextBox8.Value)
lLetzte = IIf(.Range("A65536") <> "", 65536, .Range("A65536").End(xlUp).Row) + 1
If lLetzte < 2 Then lLetzte = 2
Label8.Caption = "Anzahl Datensätze: " & (lLetzte - 1)
.Range(.Cells(2, 1), .Cells(lLetzte, 8)).Sort _
Key1:=.Cells(1, 1), Order1:=xlAscending, _
Key2:=.Cells(1, 2), Order2:=xlAscending, _
Key3:=.Cells(1, 4), Order3:=xlAscending, _
Header:=xlGuess
.Columns("A:H").EntireColumn.AutoFit
Call Zeilen_faerben
With ListBox1
Call Array_fuellen
.Clear
.Column = aTmp
End With
.Protect Password:="Geheim"
End With
Application.ScreenUpdating = True
CommandButton3.Enabled = False
CommandButton4.Enabled = False
End Sub
Private Sub CommandButton4_Click()
With Worksheets("Tabelle1")
.Unprotect Password:="Geheim"
If FundZeile <> 0 Then
If MsgBox("Wollen Sie den/die """ & TextBox2.Value & " " & _
TextBox1.Value & """ wirklich löschen.", _
vbYesNo + vbQuestion, " Löschabfrage, nur zur Sicherheit.") = vbYes Then
.Rows(FundZeile).Delete Shift:=xlUp
.Columns("A:H").EntireColumn.AutoFit
Call Zeilen_faerben
ListBox1.RemoveItem ListBox1.ListIndex
ListBox1.ListIndex = -1
Unload UserForm1
End If
End If
.Protect Password:="Geheim"
End With
CommandButton3.Enabled = False
CommandButton4.Enabled = False
End Sub
Private Sub TextBox3_Change()
End Sub
Private Sub UserForm_Activate()
Dim lLetzte As String
Call Array_fuellen
Me.Caption = "Lagerverwaltung Dallmayr"
Me.Width = 490
Me.Height = 420
With ListBox1
.Height = 82
.Left = 12
.Top = 12
.Width = 460
.Font.Size = 10
.ForeColor = RGB(0, 0, 255)
.ColumnCount = 8
.ColumnWidths = _
("2,5 cm;4,5 cm;2 cm;1 cm;1 cm;1 cm;1 cm;2 cm")
.Clear
If WorksheetFunction.CountA(aTmp()) > 0 Then
.Column = aTmp
End If
End With
CommandButton3.Enabled = False
CommandButton4.Enabled = False
With Worksheets("Tabelle1")
lLetzte = IIf(IsEmpty(.Cells(Rows.Count, 1)), _
.Cells(Rows.Count, 1).End(xlUp).Row, Rows.Count)
If lLetzte < 2 Then lLetzte = 2
Label8.Caption = "Anzahl Datensätze: " & (lLetzte - 1)
End With
End Sub