AW: Combobox färben
06.11.2019 08:44:24
schlu
Hallo Werner,
vielen Dank!
Geht das wohl auch, innerhalb eines Commandbuttons, der bereits andere Felder auf "leer" überprüft und eine Messagebox ausgibt?
Hier ist mein Code, der bereits für die Prüfung der leeren Felder und Generation einer Msgbox etc gut funktioniert und wo deine obige Prüfung mitintegriert werden sollte.
Private Sub CommandButton22_Click()
Dim sFileName As String
Dim myRange As Range, cel As Range
Set myRange = Tabelle1.Range("A1:CC16")
Dim objSh As Shape
Dim Leer As String, LeerCombo As String, msgText As String
' rote Zellen weiß färben und leere Zellen rot färben
For Each cel In myRange
If cel.Interior.ColorIndex = 3 Then cel.Interior.ColorIndex = 2
If Trim(cel.Value) = "" Then cel.Interior.ColorIndex = 3
Next cel
'Überprüfen der Comboxen, Steuerelemente sind msoOLEconrolobjects
For Each objSh In Tabelle1.Shapes
With objSh
If .Type = msoOLEControlObject Then
'Überprüfen der Active-X Comboboxen
If InStr(LCase(.OLEFormat.progID), "combobox") > 0 Then ' combobox ist als _
Wort enthalten
If objSh.OLEFormat.Object.Object.ListIndex = -1 Then 'gleich minus 1 _
bedeutet leer und größer minus 1 /0 bedeutet gefüllt
If LeerCombo = "" Then
LeerCombo = objSh.Name 'Der Name des Object Shapes, sprich hier Combo _
box
Else
LeerCombo = LeerCombo & ", " & objSh.Name 'Aufreihung
End If
End If
End If
ElseIf .Type = msoFormControl Then
'Überprüfen der FormControl-Comboboxen (DropDowns)
If .FormControlType = xlDropDown Then
If objSh.ControlFormat.ListIndex = 0 Then
If LeerCombo = "" Then
LeerCombo = objSh.Name
Else
LeerCombo = LeerCombo & ", " & objSh.Name 'Aufreihung
End If
End If
End If
End If
End With
Next
For Each cel In myRange
If cel.Address = cel.MergeArea(1).Address And cel.Value = "" Then _
Leer = Leer & cel.Address & ", "
Next
If Len(Leer & LeerCombo) = 0 Then 'alle Zellen sind ausgefüllt
'Dateiname aus Combobox holen
sFileName = Format(Date, "yyyy/mm/dd_") & "Verpackung Produktionslinie_" & "Linie " & _
ComboBox21.Value
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:= _
"C:\Users\SchluetO\Desktop\OliviaSchlüter\12_Test VBA Speicherort\BDE_Verpackung _
Produktionslinie\" & sFileName & ".xls", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Application.DisplayAlerts = True
Application.Quit
Else
If Leer "" Then
Leer = Left(Leer, Len(Leer) - 2)
msgText = "Die roten Felder "
End If
If LeerCombo "" Then
msgText = msgText & IIf(Leer "", vbLf & "und die", "Die") & " Drop-Down-Felder " _
End If
msgText = msgText & vbLf & "müssen noch ausgefüllt werden."
MsgBox msgText
End If
End Sub
Vielen Dank!