Problem beim erweitern eines Dropdownmenüs
30.03.2015 15:40:04
Julian
ich habe da mal wieder ein kleines Problem bei dem Ihr mir hoffentlich weiter helfen könnt.
Ich habe eine Lieferscheinvorlage auf der ich Artikel mithilfe eines Dropdownmenüs auswähle. Diese Artikel befinden sich auf Lieferschein1("C58:C1200"). Über eine Userform kann ich neue Artikel einpflegen, dass funktioniert auch so weit. Allerdings möchte ich nun, dass C58:C1200 dann wieder sortiert wird und der neue Artikel in die vorhandenen alten Artikel einsortiert wird.
Hierbei spuckt er mir aber immer einen Fehler aus, sobald ich die Formel auf dem 2. Lieferschein benutze(neues Tabellenblatt mit Dropdownbezug zum 1.
Hier mein VBA Code:
Option Explicit
Option Compare Text
Private Sub UserForm1_Initialize()
Dim lZeile As Long
TextBox1 = ""
ListBox1.Clear
lZeile = 58
Do While Trim(CStr(Tabelle1.Cells(lZeile, 3).Value)) ""
ListBox1.AddItem Trim(CStr(Tabelle1.Cells(lZeile, 3).Value))
lZeile = lZeile + 1
Loop
Rows("58:1200").Select
Selection.EntireRow.Hidden = False
End Sub
Private Sub CommandButton1_Click()
Dim lZeile As Long
lZeile = 58
Do While Trim(CStr(Tabelle1.Cells(lZeile, 3).Value)) ""
lZeile = lZeile + 1
Loop
Tabelle1.Cells(lZeile, 3) = CStr("Neuer Eintrag Zeile " & lZeile)
ListBox1.AddItem CStr("Neuer Eintrag Zeile " & lZeile)
ListBox1.ListIndex = ListBox1.ListCount - 1
End Sub
Private Sub CommandButton2_Click()
Dim lZeile As Long
If ListBox1.ListIndex = -1 Then Exit Sub
lZeile = 58
Do While Trim(CStr(Tabelle1.Cells(lZeile, 3).Value)) ""
If ListBox1.Text = Trim(CStr(Tabelle1.Cells(lZeile, 3).Value)) Then
Tabelle1.Rows(CStr(lZeile & ":" & lZeile)).Delete
Call UserForm1_Initialize
If ListBox1.ListCount > 0 Then ListBox1.ListIndex = 0
Exit Do
End If
lZeile = lZeile + 1
Loop
End Sub
Private Sub CommandButton3_Click()
Dim lZeile As Long
If ListBox1.ListIndex = -1 Then Exit Sub
If Trim(CStr(TextBox1.Text)) = "" Then
MsgBox "Sie müssen mindestens einen Namen eingeben!", vbCritical + vbOKOnly, "FEHLER!" _
Exit Sub
End If
lZeile = 58
Do While Trim(CStr(Tabelle1.Cells(lZeile, 3).Value)) ""
If ListBox1.Text = Trim(CStr(Tabelle1.Cells(lZeile, 3).Value)) Then
Tabelle1.Cells(lZeile, 3).Value = Trim(CStr(TextBox1.Text))
If ListBox1.Text Trim(CStr(TextBox1.Text)) Then
Call UserForm1_Initialize
If ListBox1.ListCount > 0 Then ListBox1.ListIndex = 0
End If
Exit Do
End If
lZeile = lZeile + 1
Loop
Sheets("Lieferschein1").Select
Range("C58:C1200").Select
Selection.Sort Key1:=Range("C58"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End Sub
Private Sub CommandButton4_Click()
Unload Me
Sheets("Lieferschein1").Select
Range("C58:C1200").Select
Selection.Sort Key1:=Range("C58"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Rows("58:1200").Select
Selection.EntireRow.Hidden = True
End Sub
Private Sub ListBox1_Click()
Dim lZeile As Long
TextBox1 = ""
If ListBox1.ListIndex >= 0 Then
lZeile = 58
Do While Trim(CStr(Tabelle1.Cells(lZeile, 3).Value)) ""
If ListBox1.Text = Trim(CStr(Tabelle1.Cells(lZeile, 3).Value)) Then
TextBox1 = Trim(CStr(Tabelle1.Cells(lZeile, 3).Value))
Exit Do
End If
lZeile = lZeile + 1
Loop
End If
End Sub
Private Sub UserForm1_Activate()
If ListBox1.ListCount > 0 Then ListBox1.ListIndex = 0
End Sub
Hier meine vorhandene Datei:https://www.herber.de/bbs/user/96728.xlsm