AW: userform ungültige Eigenschaftswerte
24.05.2010 12:04:36
fcs
Hallo Daniel,
hab mich auch schon ein paar Minuten durch dein Userform gesucht/gekämpft.
Die Meldung wird ausgelöst, weil die Eigenschaft "MatchRequired" für die ComboBox "cboAKdNr" auf True gesetzt ist, was auf den 1. Blick ja auch Sinn macht.
Das Problem ist jetzt, dass wenn du als Nummer "neu" wählst in der Prozedur "Private Sub cboAKdNr_click()"
die nächste Kunden-Nummer berechnet wird und der Wert der Kombobox auf diese Nummer gesetzt wird. Da diese Nummer in der Auswahliste fehlt kommt es beim Verlassen der Kombobox zu der Fehlermeldung.
Einfachste Lösung: Du setzt die Eigenschaft "MatchRequired" für die ComboBox "cboAKdNr" auf False. Dann scheint alles zu funktionieren.
Andere Lösungen werden etwas komplizierter. Wenn die Auswahlliste der Box um die neue Nummer ergänzt wird und anschliessend der Wert auf die Neue Nummer gesetzt wird, dann werden das Change- und/oder Click-Ereignis der Combobox nochmals ausgelöst und es kommt zu weiteren Fehlermeldungen. Dies kann man nur mit Hilfe einer entsprechenden Prüfvariablen umgehen, da Application.DisableEvents in UF nicht funktioniert.
Gruß
Franz
'Zuätzliche Variable im UF-Modul dekarieren
Option Explicit
Dim bolBox As Boolean
Private Sub cboAKdNr_Change()
Dim Zelle As Range
If bolBox = True Then Exit Sub
bolBox = True
Set Zelle = rngV.Columns(2).Find(what:=cboAKdNr.Text, lookat:=xlWhole)
If Not Zelle Is Nothing Then cboAKdNr.ListIndex = Zelle.Row - 1
bolBox = False
End Sub
Private Sub cboAKdNr_DropButtonClick()
If bolBox = True Then Exit Sub
bolBox = True
With cboAKdNr
.List = rngV.Columns(2).Resize(WorksheetFunction.Max(2, rngV.Rows.Count)).Value2
.List(0, 0) = "neu"
End With
bolBox = False
End Sub
Private Sub cboAKdNr_click()
Dim arr, newNumber
If bolBox = True Then Exit Sub
bolBox = True
Select Case cboAKdNr.Value
Case "neu"
'neue Kunden-Nummer holen
Application.ScreenUpdating = False
Set wb = DB_Sperren_zum_Schreiben(dbV)
newNumber = WorksheetFunction.Max(100, _
WorksheetFunction.Max(ThisWorkbook.Sheets(dbV).Columns(2)) + 1)
cboAKdNr.AddItem newNumber
wb.Sheets(1).Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Value = newNumber
DB_Speichern_und_Freigeben wb
cboAKdNr = newNumber
Application.ScreenUpdating = True
Call A_Zeile_hinzu
Case Else
With rngA.Columns(2)
If WorksheetFunction.CountIf(.Cells, cboAKdNr) > 0 Then
LB_Artikel.List = .Find(what:=cboAKdNr.Value, _
lookat:=xlWhole).Resize(WorksheetFunction.CountIf(.Cells, cboAKdNr.Value), _
LB_Artikel.ColumnCount).Value2
Else
LB_Artikel.Clear
End If
End With
arr = rngV.Columns(2).Find(what:=cboAKdNr.Value, lookat:=xlWhole).Resize(1, 8).Value2
tbAName = arr(1, 2)
tbAAddresse = arr(1, 3)
tbATel = arr(1, 4)
tbAMail = arr(1, 5)
tbAPausch = arr(1, 6)
chkPauschbez = arr(1, 6) = arr(1, 7)
tbAProv = arr(1, 8) * 100 & "%"
cboAArtikel.Value = ""
cboAFarbe.Value = ""
cboAMarke.Value = ""
'Grösse
'Text
tbAPmax = ""
tbAPmin = ""
End Select
bolBox = False
End Sub