Userform funktioniert nicht wie programmiert
13.02.2025 14:06:44
grigri
ich habe mir eine Excel Tabelle gebastelt wo ich meine Ausgabenrechnungen mit Preis, Datum, Garantiezeitraum und Ablageort einpflegen möchte.
Die Tabelle habe ich mit VBA versehen und ich möchte die Werte über eine Userform eingeben die auch schon einige Daten aus dem Sheet abrufen soll.
Beim Aufrufen der Userform mit dem Button "neue Rechnung" soll die Userform1 aufgerufen werden.
Gleichzeitig sollen in der TextBox1 eine laufende Nummer und in der TextBox5 das aktuelle Jahr, sowie in der ComboBox 1 und 2 Werte aus der Exceltabelle eingelesen werden damit ich hier eine Datenbank erstellen kann.
An sich war ich schon fertig und alles hat wie gewollt funktioniert, Danach habe ich nur mehr einige Anpassungen durchgeführt und seitdem funktioniert nichts mehr.
Ich habe schon versucht alles wieder zurückzusetzen soweit ich mich erinnern konnte, auch mit Chat GPT habe ich es versucht. Leider ohne Erfolg.
Vielleicht sieht ja einer von euch was dass ich übersehe weil ich den Wald vor lauter Bäumen nicht erkenne kann
Danke schon mal im Voraus
Nachstehend mein Code:
Option Explicit
Public BoEnter As Boolean
Private Sub Combobox2_Change()
Private Sub UserForm1_Initialize()
Dim ws As Worksheet
Dim rngC As Range, rngD As Range
Dim cell As Range
Dim dictC As Object, dictD As Object
Dim arrC As Variant, arrD As Variant
Dim i As Integer, j As Integer
Dim temp As String
Dim lastNum As Double
Dim currentYear As String
' Arbeitsblatt setzen
Set ws = ThisWorkbook.Sheets("Rechnungen")
' --- ComboBox1 mit Spalte C füllen ---
Set rngC = ws.Range("C2:C" & ws.Cells(ws.Rows.Count, "C").End(xlUp).Row)
Set dictC = CreateObject("Scripting.Dictionary")
For Each cell In rngC
If Not dictC.exists(cell.Value) And cell.Value > "" Then
dictC.Add cell.Value, Nothing
End If
Next cell
arrC = dictC.Keys
Call SortArray(arrC) ' Alphabetisch sortieren
Me.Combobox1.Clear
Me.Combobox1.List = arrC
' --- ComboBox2 mit Spalte D füllen ---
Set rngD = ws.Range("D2:D" & ws.Cells(ws.Rows.Count, "D").End(xlUp).Row)
Set dictD = CreateObject("Scripting.Dictionary")
For Each cell In rngD
If Not dictD.exists(cell.Value) And cell.Value > "" Then
dictD.Add cell.Value, Nothing
End If
Next cell
arrD = dictD.Keys
Call SortArray(arrD) ' Alphabetisch sortieren
Me.Combobox2.Clear
Me.Combobox2.List = arrD
' --- TextBox1: Nächste Nummer in Spalte B finden ---
On Error Resume Next
lastNum = Application.WorksheetFunction.Max(ws.Range("B2:B" & ws.Cells(ws.Rows.Count, "B").End(xlUp).Row))
On Error GoTo 0
If lastNum = 0 Then
lastNum = 1
Else
lastNum = lastNum + 1
End If
Me.Textbox1.Value = lastNum
' --- TextBox5: Aktuelles Jahr setzen ---
currentYear = Year(Date)
Me.TextBox5.Value = currentYear
End Sub
' --- Hilfsfunktion zum Sortieren eines Arrays ---
Private Sub SortArray(arr As Variant)
Dim i As Integer, j As Integer
Dim temp As String
For i = LBound(arr) To UBound(arr) - 1
For j = i + 1 To UBound(arr)
If arr(i) > arr(j) Then
temp = arr(i)
arr(i) = arr(j)
arr(j) = temp
End If
Next j
Next i
End Sub
Private Sub TextBox4_Change()
If BoEnter = False Then
Dim strValue As String
strValue = Trim(Me.Textbox4.Text)
' Wenn genau 2 Zeichen eingegeben wurden und kein Punkt vorhanden ist,
' wird der Wert aus "Geplant" mit einem nachfolgenden Punkt in TextBox4 eingetragen.
If Len(strValue) = 2 Then
If InStr(strValue, ".") = 0 Then
Me.Textbox4.Text = Textbox4 & "."
End If
' Wenn genau 5 Zeichen vorliegen, wird geprüft, ob bereits zwei Punkte vorhanden sind.
ElseIf Len(strValue) = 5 Then
Dim dotCount As Long
dotCount = Len(strValue) - Len(Replace(strValue, ".", ""))
If dotCount 2 Then
Me.Textbox4.Text = strValue & "." & Format(Now(), "yyyy")
End If
End If
End If
End Sub
Private Sub speichern_Click()
Dim z As Long
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Rechnungen")
z = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row + 1
ws.Cells(z, 2).Value = Textbox1.Value
ws.Cells(z, 3).Value = Combobox1.Value
ws.Cells(z, 4).Value = Combobox2.Value
ws.Cells(z, 5).Value = Textbox2.Value
ws.Cells(z, 8).Value = TextBox8.Value
If IsDate(TextBox7.Value) Then
ws.Cells(z, 9).Value = CDate(TextBox7.Value)
ws.Cells(z, 9).NumberFormat = "dd.mm.yyyy"
Else
ws.Cells(z, 9).Value = ""
End If
ws.Cells(z, 6).Value = Textbox3.Value
If IsDate(Textbox4.Value) Then
ws.Cells(z, 7).Value = CDate(Textbox4.Value)
ws.Cells(z, 7).NumberFormat = "dd.mm.yyyy"
Else
ws.Cells(z, 7).Value = ""
End If
ws.Cells(z, 10).Value = Combobox4.Value
ws.Cells(z, 11).Value = TextBox5.Value
Unload Me
End Sub
Private Sub Textbox3_Keypress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii >= Asc("a") And KeyAscii = Asc("z") Then KeyAscii = KeyAscii + Asc("A") - Asc("a")
End Sub
Private Sub TextBox8_Change()
Dim dtStart As Date
Dim Jahre As Long
Dim dtErgebnis As Date
If Not IsDate(Textbox4.Value) Then
TextBox7.Value = ""
Exit Sub
End If
dtStart = CDate(Textbox4.Value)
If IsNumeric(TextBox8.Value) And Trim(TextBox8.Value) > "" Then
Jahre = CLng(TextBox8.Value)
Else
TextBox7.Value = ""
Exit Sub
End If
dtErgebnis = DateAdd("yyyy", Jahre, dtStart)
TextBox7.Value = Format(dtErgebnis, "dd.mm.yyyy")
End Sub
Anzeige