Public Sub Prüfung()
Dim ole As OLEObject
'Blättname anpassen
With Worksheets("Tabelle1")
For Each ole In .OLEObjects
If TypeName(ole.Object) = "ComboBox" Then
ole.Object.BackColor = IIf(ole.Object.Value = "", &HFF&, &H80000005)
End If
Next ole
End With
End Sub
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
Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden
Suche nach den besten AntwortenEntdecke unsere meistgeklickten Beiträge in der Google Suche
Top 100 Threads jetzt ansehen