Problem mit User Form in Liste
Hallo,
habe da mal wieder ein Problem mit einer Liste vielleicht kann mir ja jemand helfen ich möchte in der User Form Einträge machen und zwar wie folgt, ich benötige als erstens Seriennummer, Kundennummer, das Datum an Kunden und das Kürzel vom Namen und wenn ich dann die User Form aktualisiere kommt der Debugger, das ist das erste Problem. Als zweites wenn ich dann irgendwann mal in ein paar Tagen oder Wochen die User Form wieder aufmache und dann mit dem zweiten Datum von Kunden ergänze sollten sich die drei Roten Felder mit füllen! Dieses wäre mein zweites Problem, beim aktualisieren ist diesmal alles okay. Vielleicht hat ja jemand eine Lösung weil ich weiß hier echt nicht weiter und wäre für eure Ideen und Hilfe sehr dankbar.
' Arbeitsblatt Variable
Dim ws As Worksheet
Private Sub btnClose_Click()
End
End Sub
Private Sub btnDelete_Click()
Dim objControl As Control
For Each objControl In Controls
Select Case TypeName(objControl)
Case "TextBox"
objControl.Text = ""
Case "ComboBox"
objControl.ListIndex = -1
Case "CheckBox"
objControl.Value = False
Case "OptionButton"
objControl.Value = False
End Select
Next
End Sub
Private Sub btnInsert_Click()
' Wenn eine Seriennummer gefunden wurde
If comboSerial.MatchFound Then
' mach ein Update der jeweiligen Zeile
entryRow = comboSerial.ListIndex + 2
Else
' Neuer Eintrag, suche nächste leere Zeile
entryRow = ws.Cells(Rows.Count, "A").End(xlUp).Row + 1
' Setze Seriennummer
ws.Cells(entryRow, "A").Value = comboSerial.Value
End If
' Setze Kundennummer
ws.Cells(entryRow, "C").Value = comboClient.Value
' Setze Bearbeiterkürzel
ws.Cells(entryRow, "h").Value = txtEditor.Value
' Setze Datum
ws.Cells(entryRow, "D").Value = CDate(txtDatum.Value)
' Setze Datum 2
ws.Cells(entryRow = "f").Value = txtDatum1.Value
' Setze Datum 3
' Setze Bemerkungen
ws.Cells(entryRow, "i").Value = txtBemerkungen.Value
ws.Cells(entryRow, "H").Value = CDbl(txtFlTg.Value)
ws.Cells(entryRow, "n").Value = CDbl(txtFlTg2.Value)
ws.Cells(entryRow, "o").Value = CDbl(txtFlTg3.Value)
ws.Cells(entryRow, "e").Value = txtDatum1.Value - CDate(txtDatum.Value)
ws.Cells(entryRow, "o").Value = CDbl(txtFlTg.Value) * CDbl(txtFlTg2.Value)
' Leere die Felder für die nächste Eingabe
comboSerial.Value = ""
comboClient.Value = ""
txtEditor.Value = ""
txtDatum.Value = ""
txtDatum1.Value = ""
txtBemerkungen.Value = ""
'Combo-Werte in der Form aktualisieren
UpdateComboValues
' Fokus auf Seriennummer-Feld setzen
comboSerial.SetFocus
End Sub
Private Sub comboSerial_Change()
' Wenn eine Seriennummer gefunden wurde
If comboSerial.MatchFound Then
' User will aktualisieren
' setze Control Eigenschaften
btnInsert.Caption = "Aktualisieren"
btnDelete.Enabled = True
comboSerial.BackColor = vbGreen
' Setze Felder auf die Inhalte aus der Tabelle
comboClient.Value = Cells(comboSerial.ListIndex + 2, "C").Value
txtEditor.Value = Cells(comboSerial.ListIndex + 2, "H").Value
txtDatum.Value = Cells(comboSerial.ListIndex + 2, "D").Value
txtDatum1.Value = Cells(comboSerial.ListIndex + 2, "F").Value
txtBemerkungen.Value = Cells(comboSerial.ListIndex + 2, "I").Value
txtFlTg.Value = Cells(comboSerial.ListIndex + 2, "M").Value
txtFlTg2.Value = Cells(comboSerial.ListIndex + 2, "N").Value
txtFlTg3.Value = Cells(comboSerial.ListIndex + 2, "O").Value
Else
' User will neue Seriennummer einfügen
' setze Control Eigenschaften
btnInsert.Caption = "Einfügen"
btnDelete.Enabled = False
comboSerial.BackColor = vbYellow
comboClient.Value = "Einfügen"
txtEditor.Value = "Einfügen"
txtDatum.Value = "Einfügen"
txtDatum1.Value = "Einfügen"
txtBemerkungen.Value = "Einfügen"
txtFlTg.Value = "Einfügen"
txtFlTg2.Value = "Einfügen"
txtFlTg3.Value = "Einfügen"
End If
End Sub
Private Sub txtFlTg_Change()
formEntry.txtFlTg = Format(txtFlTg.Text, "##")
If formEntry.txtFlTg.Value > 0 Then
formEntry.txtFlTg.ForeColor = &HFF&
End If
End Sub
Private Sub txtFlTg3_Change()
formEntry.txtFlTg3 = Format(txtFlTg3.Text, "#,##0.00 €")
If formEntry.txtFlTg3.Value > 0 Then
formEntry.txtFlTg3.ForeColor = &HFF&
End If
End Sub
Private Sub UserForm_Initialize()
'Werte beim Aufruf des Formulars eintragen. Formular initialisieren
With Me
.txtDatum1.Value = Date
.txtFlTg2.Value = ("0,10")
'Wir arbeiten auf dem aktuellen Arbeitsblatt von dem aus das Fenster aufgerufen wurde
Set ws = ActiveSheet
'Combo-Werte in der Form aktualisieren
UpdateComboValues
End With
End Sub
' Prozedur für das Update der Combobox-Werte
Sub UpdateComboValues()
Dim lastRow As Long
' letzte belegte Zeile ermitteln
lastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
' RowSource Eigenschaft zum Füllen der Comboboxen setzen
comboSerial.RowSource = ws.Range("A2:A" & lastRow).Address
comboClient.RowSource = ws.Range("C2:C" & lastRow).Address
End Sub
Gruß kluthi
habe da mal wieder ein Problem mit einer Liste vielleicht kann mir ja jemand helfen ich möchte in der User Form Einträge machen und zwar wie folgt, ich benötige als erstens Seriennummer, Kundennummer, das Datum an Kunden und das Kürzel vom Namen und wenn ich dann die User Form aktualisiere kommt der Debugger, das ist das erste Problem. Als zweites wenn ich dann irgendwann mal in ein paar Tagen oder Wochen die User Form wieder aufmache und dann mit dem zweiten Datum von Kunden ergänze sollten sich die drei Roten Felder mit füllen! Dieses wäre mein zweites Problem, beim aktualisieren ist diesmal alles okay. Vielleicht hat ja jemand eine Lösung weil ich weiß hier echt nicht weiter und wäre für eure Ideen und Hilfe sehr dankbar.
' Arbeitsblatt Variable
Dim ws As Worksheet
Private Sub btnClose_Click()
End
End Sub
Private Sub btnDelete_Click()
Dim objControl As Control
For Each objControl In Controls
Select Case TypeName(objControl)
Case "TextBox"
objControl.Text = ""
Case "ComboBox"
objControl.ListIndex = -1
Case "CheckBox"
objControl.Value = False
Case "OptionButton"
objControl.Value = False
End Select
Next
End Sub
Private Sub btnInsert_Click()
' Wenn eine Seriennummer gefunden wurde
If comboSerial.MatchFound Then
' mach ein Update der jeweiligen Zeile
entryRow = comboSerial.ListIndex + 2
Else
' Neuer Eintrag, suche nächste leere Zeile
entryRow = ws.Cells(Rows.Count, "A").End(xlUp).Row + 1
' Setze Seriennummer
ws.Cells(entryRow, "A").Value = comboSerial.Value
End If
' Setze Kundennummer
ws.Cells(entryRow, "C").Value = comboClient.Value
' Setze Bearbeiterkürzel
ws.Cells(entryRow, "h").Value = txtEditor.Value
' Setze Datum
ws.Cells(entryRow, "D").Value = CDate(txtDatum.Value)
' Setze Datum 2
ws.Cells(entryRow = "f").Value = txtDatum1.Value
' Setze Datum 3
' Setze Bemerkungen
ws.Cells(entryRow, "i").Value = txtBemerkungen.Value
ws.Cells(entryRow, "H").Value = CDbl(txtFlTg.Value)
ws.Cells(entryRow, "n").Value = CDbl(txtFlTg2.Value)
ws.Cells(entryRow, "o").Value = CDbl(txtFlTg3.Value)
ws.Cells(entryRow, "e").Value = txtDatum1.Value - CDate(txtDatum.Value)
ws.Cells(entryRow, "o").Value = CDbl(txtFlTg.Value) * CDbl(txtFlTg2.Value)
' Leere die Felder für die nächste Eingabe
comboSerial.Value = ""
comboClient.Value = ""
txtEditor.Value = ""
txtDatum.Value = ""
txtDatum1.Value = ""
txtBemerkungen.Value = ""
'Combo-Werte in der Form aktualisieren
UpdateComboValues
' Fokus auf Seriennummer-Feld setzen
comboSerial.SetFocus
End Sub
Private Sub comboSerial_Change()
' Wenn eine Seriennummer gefunden wurde
If comboSerial.MatchFound Then
' User will aktualisieren
' setze Control Eigenschaften
btnInsert.Caption = "Aktualisieren"
btnDelete.Enabled = True
comboSerial.BackColor = vbGreen
' Setze Felder auf die Inhalte aus der Tabelle
comboClient.Value = Cells(comboSerial.ListIndex + 2, "C").Value
txtEditor.Value = Cells(comboSerial.ListIndex + 2, "H").Value
txtDatum.Value = Cells(comboSerial.ListIndex + 2, "D").Value
txtDatum1.Value = Cells(comboSerial.ListIndex + 2, "F").Value
txtBemerkungen.Value = Cells(comboSerial.ListIndex + 2, "I").Value
txtFlTg.Value = Cells(comboSerial.ListIndex + 2, "M").Value
txtFlTg2.Value = Cells(comboSerial.ListIndex + 2, "N").Value
txtFlTg3.Value = Cells(comboSerial.ListIndex + 2, "O").Value
Else
' User will neue Seriennummer einfügen
' setze Control Eigenschaften
btnInsert.Caption = "Einfügen"
btnDelete.Enabled = False
comboSerial.BackColor = vbYellow
comboClient.Value = "Einfügen"
txtEditor.Value = "Einfügen"
txtDatum.Value = "Einfügen"
txtDatum1.Value = "Einfügen"
txtBemerkungen.Value = "Einfügen"
txtFlTg.Value = "Einfügen"
txtFlTg2.Value = "Einfügen"
txtFlTg3.Value = "Einfügen"
End If
End Sub
Private Sub txtFlTg_Change()
formEntry.txtFlTg = Format(txtFlTg.Text, "##")
If formEntry.txtFlTg.Value > 0 Then
formEntry.txtFlTg.ForeColor = &HFF&
End If
End Sub
Private Sub txtFlTg3_Change()
formEntry.txtFlTg3 = Format(txtFlTg3.Text, "#,##0.00 €")
If formEntry.txtFlTg3.Value > 0 Then
formEntry.txtFlTg3.ForeColor = &HFF&
End If
End Sub
Private Sub UserForm_Initialize()
'Werte beim Aufruf des Formulars eintragen. Formular initialisieren
With Me
.txtDatum1.Value = Date
.txtFlTg2.Value = ("0,10")
'Wir arbeiten auf dem aktuellen Arbeitsblatt von dem aus das Fenster aufgerufen wurde
Set ws = ActiveSheet
'Combo-Werte in der Form aktualisieren
UpdateComboValues
End With
End Sub
' Prozedur für das Update der Combobox-Werte
Sub UpdateComboValues()
Dim lastRow As Long
' letzte belegte Zeile ermitteln
lastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
' RowSource Eigenschaft zum Füllen der Comboboxen setzen
comboSerial.RowSource = ws.Range("A2:A" & lastRow).Address
comboClient.RowSource = ws.Range("C2:C" & lastRow).Address
End Sub
Gruß kluthi
Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben
Content-ID: 346861
Url: https://administrator.de/forum/problem-mit-user-form-in-liste-346861.html
Ausgedruckt am: 20.04.2025 um 07:04 Uhr