|
Hallo zusammen...
...ich hoffe hier kann mir wer helfen.
Ich habe mir eine Excel Datei mit Makros, VBA Scripten zur Adressen / Telefonnummern Verwaltung aus dem Internet heruntergeladen und probiert den Code an meine Bedürfnisse anzupassen.
Bis auf 2 Kleinigkeiten hat das auch gut geklappt.
Das 1. Problem ist das sich die Userform "entlädt" sobalt ich einen datensatz lösche.
Das 2. Problem ist das mir anstelle der eingegeben Preise die Zeilennummer in der Listbox ausgegeben wird.
Hier mal der Code...
Option Explicit
'
' Exit-Button
'
Private Sub CommandButton6_Click()
Unload UserForm1
End Sub
Private Sub Label9_Click()
End Sub
'
' Doppelklick auf einen Listbox-Eintrag
'
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 ' den Änder-Button freigeben
CommandButton4.Enabled = True ' den Lösch-Button freigeben
End Sub
'
' übernehmen
'
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
'
' die Daten sind geprüft und können in die Tabelle eingetragen werden
'
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)
' Tabelle nach "Nachname", "Vorname", "Postlz" sortieren
.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
'
' Eingabeinhalte löschen
'
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 ' den Änder-Button sperren
CommandButton4.Enabled = False ' den Lösch-Button sperren
End Sub
'
' suchen
'
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 ' den Änder-Button sperren
CommandButton4.Enabled = False ' den Lösch-Button sperren
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)
' nachfolgend werden die TextBox1.Werte gesucht und gefunden.
' Mit LookIn:=xlValues wird nach den Zellwerten gesucht.
' Mit LookAt:=xlPart muß der Suchbegriff nicht komplett mit
' dem Suchergebnis übereinstimmen.
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 ' den Änder-Button sperren
CommandButton4.Enabled = False ' den Lösch-Button sperren
Exit Sub
Anzeigen:
If FundZeile = 0 Then Exit Sub
TextBox1.Value = ActiveCell.Offset(0, 0).Value ' Art.-Nummer
TextBox2.Value = ActiveCell.Offset(0, 1).Value ' Art.-Name
TextBox3.Value = ActiveCell.Offset(0, 2).Value ' Art.-Hersteller
TextBox4.Value = ActiveCell.Offset(0, 3).Value ' Regal
TextBox5.Value = ActiveCell.Offset(0, 4).Value ' Segment
TextBox6.Value = ActiveCell.Offset(0, 5).Value ' Ebene
TextBox7.Value = ActiveCell.Offset(0, 6).Value ' Anzahl
TextBox8.Value = ActiveCell.Offset(0, 7).Value ' Artikelpreis
CommandButton3.Enabled = True ' den Änder-Button freigeben
CommandButton4.Enabled = True ' den Lösch-Button freigeben
Return
End Sub
'
' ändern
'
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
'
' die Daten sind geprüft und können in die Tabelle eingetragen werden
'
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)
' Tabelle sortieren
.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 ' den Änder-Button sperren
CommandButton4.Enabled = False ' den Lösch-Button sperren
End Sub
'
' löschen
'
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 ' den Änder-Button sperren
CommandButton4.Enabled = False ' den Lösch-Button sperren
End Sub
Private Sub TextBox3_Change()
End Sub
'
' das UserForm(ular) intialisieren, die ListBox 'geraderücken'
'
Private Sub UserForm_Activate()
Dim lLetzte As String
Call Array_fuellen
Me.Caption = "Lagerverwaltung Dallmayr"
Me.Width = 490
Me.Height = 420
With ListBox1 ' betrifft die ListBox1
.Height = 82 ' die Höhe festlegen
.Left = 12 ' den linken Randabstand festlegen
.Top = 12 ' den oberen Randabstand festlegen
.Width = 460 ' die Breite festlegen
.Font.Size = 10 ' die Schriftgröße festlegen
.ForeColor = RGB(0, 0, 255) ' Schriftfarbe immer mit RGB
.ColumnCount = 8 ' die Anzahl der Spalten festlegen
' die Breite der Spalten festlegen
.ColumnWidths = _
("2,5 cm;4,5 cm;2 cm;1 cm;1 cm;1 cm;1 cm;2 cm")
.Clear ' die ListBox leeren
If WorksheetFunction.CountA(aTmp()) > 0 Then
.Column = aTmp
End If
End With
CommandButton3.Enabled = False ' den Änder-Button sperren
CommandButton4.Enabled = False ' den Lösch-Button sperren
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
|