AW: ComboBoxen mit unterschiedlichen Werten
27.04.2022 20:55:06
Marco
Mist, ich war zu schnell, geht doch nicht. Es kommt die Fehlermeldung "typen unverträglich, 13". Markiert wird meine Userform. Den einzigen Bestandteil, den ich nicht übernommen habe, war die automatische Befüllung der Comboboxen. Da bin ich bislang noch bei meinem alten Weg geblieben...
Ansonsten hab ich den Code von Thorsten eingefügt und um die weiteren Wochentage ergänzt.
Weiß jemand, warum er mir die Fehlermeldung bringt?
Hier der Code:
Sub sbChoiceColleague()
Dim liCmb As Integer, liIdx As Integer, larCmbs(), liIdxAR As Integer, lboNOT As Boolean
'******Montag anpassen
With Verfügbarkeit
With .ComboBox1
.Text = .List(0)
End With
With .ComboBox2
.Text = .List(0)
End With
For liCmb = 3 To 28
larCmbs = fcCmbs(liCmb - 2)
With .Controls("ComboBox" & liCmb)
For liIdx = 0 To .ListCount - 1
For liIdxAR = 0 To UBound(larCmbs)
If larCmbs(liIdxAR) = .List(liIdx) Then
lboNOT = True
Exit For
End If
Next
If lboNOT = True Then
lboNOT = False
Else
.Text = .List(liIdx)
Exit For
End If
Next
If .Text = "" Then
.BackColor = vbRed
Else
.BackColor = &H80000005
End If
End With
Next
'*****Dienstag anpassen
With .ComboBox30
.Text = .List(0)
End With
With .ComboBox31
.Text = .List(0)
End With
For liCmb = 32 To 57
larCmbs = fcCmbs(liCmb - 2)
With .Controls("ComboBox" & liCmb)
For liIdx = 0 To .ListCount - 1
For liIdxAR = 0 To UBound(larCmbs)
If larCmbs(liIdxAR) = .List(liIdx) Then
lboNOT = True
Exit For
End If
Next
If lboNOT = True Then
lboNOT = False
Else
.Text = .List(liIdx)
Exit For
End If
Next
If .Text = "" Then
.BackColor = vbRed
Else
.BackColor = &H80000005
End If
End With
Next
'******Mittwoch anpassen
With .ComboBox59
.Text = .List(0)
End With
With .ComboBox60
.Text = .List(0)
End With
For liCmb = 61 To 86
larCmbs = fcCmbs(liCmb - 2)
With .Controls("ComboBox" & liCmb)
For liIdx = 0 To .ListCount - 1
For liIdxAR = 0 To UBound(larCmbs)
If larCmbs(liIdxAR) = .List(liIdx) Then
lboNOT = True
Exit For
End If
Next
If lboNOT = True Then
lboNOT = False
Else
.Text = .List(liIdx)
Exit For
End If
Next
If .Text = "" Then
.BackColor = vbRed
Else
.BackColor = &H80000005
End If
End With
Next
'**** Donnerstag anpassen
With .ComboBox88
.Text = .List(0)
End With
With .ComboBox89
.Text = .List(0)
End With
For liCmb = 90 To 115
larCmbs = fcCmbs(liCmb - 2)
With .Controls("ComboBox" & liCmb)
For liIdx = 0 To .ListCount - 1
For liIdxAR = 0 To UBound(larCmbs)
If larCmbs(liIdxAR) = .List(liIdx) Then
lboNOT = True
Exit For
End If
Next
If lboNOT = True Then
lboNOT = False
Else
.Text = .List(liIdx)
Exit For
End If
Next
If .Text = "" Then
.BackColor = vbRed
Else
.BackColor = &H80000005
End If
End With
Next
'***** Freitag anpassen
With .ComboBox117
.Text = .List(0)
End With
With .ComboBox118
.Text = .List(0)
End With
For liCmb = 119 To 144
larCmbs = fcCmbs(liCmb - 2)
With .Controls("ComboBox" & liCmb)
For liIdx = 0 To .ListCount - 1
For liIdxAR = 0 To UBound(larCmbs)
If larCmbs(liIdxAR) = .List(liIdx) Then
lboNOT = True
Exit For
End If
Next
If lboNOT = True Then
lboNOT = False
Else
.Text = .List(liIdx)
Exit For
End If
Next
If .Text = "" Then
.BackColor = vbRed
Else
.BackColor = &H80000005
End If
End With
Next
'****Samstag anpassen
With .ComboBox146
.Text = .List(0)
End With
With .ComboBox147
.Text = .List(0)
End With
For liCmb = 148 To 173
larCmbs = fcCmbs(liCmb - 2)
With .Controls("ComboBox" & liCmb)
For liIdx = 0 To .ListCount - 1
For liIdxAR = 0 To UBound(larCmbs)
If larCmbs(liIdxAR) = .List(liIdx) Then
lboNOT = True
Exit For
End If
Next
If lboNOT = True Then
lboNOT = False
Else
.Text = .List(liIdx)
Exit For
End If
Next
If .Text = "" Then
.BackColor = vbRed
Else
.BackColor = &H80000005
End If
End With
Next
'***** Sonntag anpassen
With .ComboBox175
.Text = .List(0)
End With
With .ComboBox176
.Text = .List(0)
End With
For liCmb = 177 To 202
larCmbs = fcCmbs(liCmb - 2)
With .Controls("ComboBox" & liCmb)
For liIdx = 0 To .ListCount - 1
For liIdxAR = 0 To UBound(larCmbs)
If larCmbs(liIdxAR) = .List(liIdx) Then
lboNOT = True
Exit For
End If
Next
If lboNOT = True Then
lboNOT = False
Else
.Text = .List(liIdx)
Exit For
End If
Next
If .Text = "" Then
.BackColor = vbRed
Else
.BackColor = &H80000005
End If
End With
Next
End With
End Sub
Function fcCmbs(ByVal anzahl As Integer)
Dim liIdx As Integer, larCmbs()
ReDim larCmbs(0)
For liIdx = 0 To anzahl
With Verfügbarkeit.Controls("ComboBox" & liIdx + 1)
larCmbs(UBound(larCmbs)) = .Text
ReDim Preserve larCmbs(UBound(larCmbs) + 1)
End With
Next
ReDim Preserve larCmbs(UBound(larCmbs) - 1)
fcCmbs = larCmbs
End Function
In der Userform steht:
Private Sub UserForm_Initialize()
Dim rng As Range
Dim crtl As Control
Dim Box As Control
Dim i As Integer
Dim s As Integer
'***ComboBoxen alle leeren
For Each ctrl In Verfügbarkeiten.Controls
If TypeOf ctrl Is MSForms.ComboBox Then
ctrl.Clear
End If
Next ctrl
'***ComboBoxen mit Inhalten füllen und erster Eintrag anzeigen
' SF Mo
For Each rng In Worksheets("Verfügbarkeit").Range("BF4:BF70")
If rng "" Then ComboBox1.AddItem rng
Next
' SF Di
For Each rng In Worksheets("Verfügbarkeit").Range("BG4:BG70")
If rng "" Then ComboBox30.AddItem rng
Next
'SF Mi
For Each rng In Worksheets("Verfügbarkeit").Range("BH4:BH70")
If rng "" Then ComboBox59.AddItem rng
Next
'SF Do
For Each rng In Worksheets("Verfügbarkeit").Range("BI4:BI70")
If rng "" Then ComboBox88.AddItem rng
Next
'SF Fr
For Each rng In Worksheets("Verfügbarkeit").Range("BJ4:BJ70")
If rng "" Then ComboBox117.AddItem rng
Next
'SF Sa
For Each rng In Worksheets("Verfügbarkeit").Range("BK4:BK70")
If rng "" Then ComboBox146.AddItem rng
Next
'SF So
For Each rng In Worksheets("Verfügbarkeit").Range("BL4:BL70")
If rng "" Then ComboBox175.AddItem rng
Next
ComboBox7.ListIndex = 0
'B Mo
For Each rng In Worksheets("Verfügbarkeit").Range("BM4:BM70")
If rng "" Then ComboBox2.AddItem rng
If rng "" Then ComboBox4.AddItem rng
If rng "" Then ComboBox9.AddItem rng
Next
'B Di
For Each rng In Worksheets("Verfügbarkeit").Range("BN4:BN70")
If rng "" Then ComboBox31.AddItem rng
If rng "" Then ComboBox33.AddItem rng
If rng "" Then ComboBox38.AddItem rng
Next
'B Mi
For Each rng In Worksheets("Verfügbarkeit").Range("BO4:BO70")
If rng "" Then ComboBox60.AddItem rng
If rng "" Then ComboBox62.AddItem rng
If rng "" Then ComboBox67.AddItem rng
Next
'B Do
For Each rng In Worksheets("Verfügbarkeit").Range("BP4:BP70")
If rng "" Then ComboBox89.AddItem rng
If rng "" Then ComboBox91.AddItem rng
If rng "" Then ComboBox96.AddItem rng
Next
' Fr
For Each rng In Worksheets("Verfügbarkeit").Range("BQ4:BQ70")
If rng "" Then ComboBox118.AddItem rng
If rng "" Then ComboBox120.AddItem rng
If rng "" Then ComboBox125.AddItem rng
Next
' Sa
For Each rng In Worksheets("Verfügbarkeit").Range("BR4:BR70")
If rng "" Then ComboBox147.AddItem rng
If rng "" Then ComboBox149.AddItem rng
If rng "" Then ComboBox154.AddItem rng
Next
' So
For Each rng In Worksheets("Verfügbarkeit").Range("BS4:BS70")
If rng "" Then ComboBox176.AddItem rng
If rng "" Then ComboBox178.AddItem rng
If rng "" Then ComboBox183.AddItem rng
Next
etc etc etc
'****Alle Boxen füllen
sbChoiceColleague
End Sub
In Modul 2 steht:
Option Explicit
Sub sbChoiceColleague()
Dim liCmb As Integer, liIdx As Integer, larCmbs(), liIdxAR As Integer, lboNOT As Boolean
'******Montag anpassen
With Verfügbarkeit
With .ComboBox1
.Text = .List(0)
End With
With .ComboBox2
.Text = .List(0)
End With
For liCmb = 3 To 28
larCmbs = fcCmbs(liCmb - 2)
With .Controls("ComboBox" & liCmb)
For liIdx = 0 To .ListCount - 1
For liIdxAR = 0 To UBound(larCmbs)
If larCmbs(liIdxAR) = .List(liIdx) Then
lboNOT = True
Exit For
End If
Next
If lboNOT = True Then
lboNOT = False
Else
.Text = .List(liIdx)
Exit For
End If
Next
If .Text = "" Then
.BackColor = vbRed
Else
.BackColor = &H80000005
End If
End With
Next
'*****Dienstag anpassen
With .ComboBox30
.Text = .List(0)
End With
With .ComboBox31
.Text = .List(0)
End With
For liCmb = 32 To 57
larCmbs = fcCmbs(liCmb - 2)
With .Controls("ComboBox" & liCmb)
For liIdx = 0 To .ListCount - 1
For liIdxAR = 0 To UBound(larCmbs)
If larCmbs(liIdxAR) = .List(liIdx) Then
lboNOT = True
Exit For
End If
Next
If lboNOT = True Then
lboNOT = False
Else
.Text = .List(liIdx)
Exit For
End If
Next
If .Text = "" Then
.BackColor = vbRed
Else
.BackColor = &H80000005
End If
End With
Next
'******Mittwoch anpassen
With .ComboBox59
.Text = .List(0)
End With
With .ComboBox60
.Text = .List(0)
End With
For liCmb = 61 To 86
larCmbs = fcCmbs(liCmb - 2)
With .Controls("ComboBox" & liCmb)
For liIdx = 0 To .ListCount - 1
For liIdxAR = 0 To UBound(larCmbs)
If larCmbs(liIdxAR) = .List(liIdx) Then
lboNOT = True
Exit For
End If
Next
If lboNOT = True Then
lboNOT = False
Else
.Text = .List(liIdx)
Exit For
End If
Next
If .Text = "" Then
.BackColor = vbRed
Else
.BackColor = &H80000005
End If
End With
Next
'**** Donnerstag anpassen
With .ComboBox88
.Text = .List(0)
End With
With .ComboBox89
.Text = .List(0)
End With
For liCmb = 90 To 115
larCmbs = fcCmbs(liCmb - 2)
With .Controls("ComboBox" & liCmb)
For liIdx = 0 To .ListCount - 1
For liIdxAR = 0 To UBound(larCmbs)
If larCmbs(liIdxAR) = .List(liIdx) Then
lboNOT = True
Exit For
End If
Next
If lboNOT = True Then
lboNOT = False
Else
.Text = .List(liIdx)
Exit For
End If
Next
If .Text = "" Then
.BackColor = vbRed
Else
.BackColor = &H80000005
End If
End With
Next
'***** Freitag anpassen
With .ComboBox117
.Text = .List(0)
End With
With .ComboBox118
.Text = .List(0)
End With
For liCmb = 119 To 144
larCmbs = fcCmbs(liCmb - 2)
With .Controls("ComboBox" & liCmb)
For liIdx = 0 To .ListCount - 1
For liIdxAR = 0 To UBound(larCmbs)
If larCmbs(liIdxAR) = .List(liIdx) Then
lboNOT = True
Exit For
End If
Next
If lboNOT = True Then
lboNOT = False
Else
.Text = .List(liIdx)
Exit For
End If
Next
If .Text = "" Then
.BackColor = vbRed
Else
.BackColor = &H80000005
End If
End With
Next
'****Samstag anpassen
With .ComboBox146
.Text = .List(0)
End With
With .ComboBox147
.Text = .List(0)
End With
For liCmb = 148 To 173
larCmbs = fcCmbs(liCmb - 2)
With .Controls("ComboBox" & liCmb)
For liIdx = 0 To .ListCount - 1
For liIdxAR = 0 To UBound(larCmbs)
If larCmbs(liIdxAR) = .List(liIdx) Then
lboNOT = True
Exit For
End If
Next
If lboNOT = True Then
lboNOT = False
Else
.Text = .List(liIdx)
Exit For
End If
Next
If .Text = "" Then
.BackColor = vbRed
Else
.BackColor = &H80000005
End If
End With
Next
'***** Sonntag anpassen
With .ComboBox175
.Text = .List(0)
End With
With .ComboBox176
.Text = .List(0)
End With
For liCmb = 177 To 202
larCmbs = fcCmbs(liCmb - 2)
With .Controls("ComboBox" & liCmb)
For liIdx = 0 To .ListCount - 1
For liIdxAR = 0 To UBound(larCmbs)
If larCmbs(liIdxAR) = .List(liIdx) Then
lboNOT = True
Exit For
End If
Next
If lboNOT = True Then
lboNOT = False
Else
.Text = .List(liIdx)
Exit For
End If
Next
If .Text = "" Then
.BackColor = vbRed
Else
.BackColor = &H80000005
End If
End With
Next
End With
End Sub
Function fcCmbs(ByVal anzahl As Integer)
Dim liIdx As Integer, larCmbs()
ReDim larCmbs(0)
For liIdx = 0 To anzahl
With Verfügbarkeit.Controls("ComboBox" & liIdx + 1)
larCmbs(UBound(larCmbs)) = .Text
ReDim Preserve larCmbs(UBound(larCmbs) + 1)
End With
Next
ReDim Preserve larCmbs(UBound(larCmbs) - 1)
fcCmbs = larCmbs
End Function
Danke vorab!!
Lg Marco
