AW: Formatierung/ Gültigkeit anzeigen
10.12.2006 17:49:45
fcs
Hallo André,
ich hab nich jetzt mal in VBA in die Tiefen der bedingten Formatierung und Gültigkeitsprüfung abgeseilt.
Dabei werden bei bedingten Formatierungen falls vorhanden auch mehrere Bedingungen ausgegeben.
Bei der Gültigkeitsprüfung hatte ich die Schwierigkeit zu prüfen, ob für eine Zelle einen Gültigkeitsprüfung festgelegt ist. Da ich nichts gefunden habe musste ich hier über den den ausgelösten Laufzeitfehler die Ausgabe der Prozedur steuern.
Gruss
Franz
Sub Gueltikeitsregeln()
'Trägt die Gültigkeitsregeln der Zellen der Tabelle1 in den Zellen der Tabelle 3 ein
Dim Zelle As Range, wks1 As Worksheet, wks3 As Worksheet
Dim VD As Validation, text As String, I As Integer, Formel2 As Boolean
Dim ValType As String, ValOperator As String, ValFormel As String
Set wks1 = ActiveWorkbook.Worksheets(1)
Set wks3 = ActiveWorkbook.Worksheets(3)
wks3.UsedRange.EntireRow.Clear
For Each Zelle In wks1.UsedRange
On Error Resume Next
Set VD = Zelle.Validation
ValType = VD.Type
If Err.Number = 1004 Then GoTo nexteZelle 'Zelle hat keine Gültigkeitsprüfung, was Laufzeitfehler auslöst
text = ""
ValType = ""
ValOperator = ""
ValFormel = ""
Formel2 = False
Select Case VD.Type
Case xlValidateCustom
ValType = "benutzerdefiniert"
Case xlValidateDate
ValType = "Datum"
GoSub ValOperator
Case xlValidateDecimal
ValType = "Dezimalzahl"
GoSub ValOperator
Case xlValidateInputOnly
'Hier kommt nichts an, da bei dieser Einstellung obiger Laufzeitfehler ausgelöst wird.
ValType = "Jede Eingabe"
Case xlValidateList
ValType = "Liste"
Case xlValidateTextLength
ValType = "Eingabelänge"
GoSub ValOperator
Case xlValidateTime
ValType = "Zeiteingabe"
GoSub ValOperator
Case xlValidateWholeNumber
ValType = "Ganze Zahl"
GoSub ValOperator
Case Else
'do nothing
End Select
If Formel2 = True Then
ValFormel = VD.Formula1 & " und " & VD.Formula2
Else
ValFormel = VD.Formula1
End If
text = ValType & " " & ValOperator & " " & ValFormel
If Trim(text) <> "" Then
wks3.Range(Zelle.Address).Value = text
End If
nexteZelle:
Next
wks3.UsedRange.Columns.ColumnWidth = 30
wks3.UsedRange.WrapText = True
Exit Sub
'Validation Operator bestimmen und Ausgabetext festlegen, sowie ggf. Status für Formel2 setzen
ValOperator:
Select Case VD.Operator
Case xlBetween
ValOperator = "zwischen"
Formel2 = True
Case xlNotBetween
ValOperator = "nicht zwischen"
Formel2 = True
Case xlEqual
ValOperator = "ist gleich"
Case xlNotEqual
ValOperator = "ist nicht gleich"
Case xlLess
ValOperator = "ist kleiner"
Case xlLessEqual
ValOperator = "ist kleiner oder gleich"
Case xlGreater
ValOperator = "ist größer"
Case xlGreaterEqual
ValOperator = "ist größer oder gleich"
Case Else
'do nothing
End Select
Return
End Sub
Sub BedingteFormatierungen()
'Trägt die bedingten Formatierungen der Zellen der Tabelle1 in den Zellen der Tabelle 2 ein
Dim Zelle As Range, wks1 As Worksheet, wks2 As Worksheet
Dim FC As FormatCondition, text As String, I As Integer, Formel2 As Boolean
Dim BedType As String, BedOperator As String, BedFormel As String
Set wks1 = ActiveWorkbook.Worksheets(1)
Set wks2 = ActiveWorkbook.Worksheets(2)
wks2.UsedRange.EntireRow.Clear
For Each Zelle In wks1.UsedRange
If Zelle.FormatConditions.Count > 0 Then
I = 0
text = ""
For Each FC In Zelle.FormatConditions
BedType = ""
BedOperator = ""
BedFormel = ""
Formel2 = False
I = I + 1
Select Case FC.Type
Case xlCellValue
BedType = "Zellwert"
Select Case FC.Operator
Case xlBetween
BedOperator = "zwischen"
Formel2 = True
Case xlNotBetween
BedOperator = "nicht zwischen"
Formel2 = True
Case xlEqual
BedOperator = "ist gleich"
Case xlNotEqual
BedOperator = "ist nicht gleich"
Case xlLess
BedOperator = "ist kleiner"
Case xlLessEqual
BedOperator = "ist kleiner oder gleich"
Case xlGreater
BedOperator = "ist größer"
Case xlGreaterEqual
BedOperator = "ist größer oder gleich"
Case Else
'do nothing
End Select
Case xlExpression
BedType = "Formel"
Case Else
'do nothing
End Select
If Formel2 = True Then
BedFormel = FC.Formula1 & " und " & FC.Formula2
Else
BedFormel = FC.Formula1
End If
If text = "" Then
text = "Bed " & I & ": " & BedType & " " & BedOperator & " " & BedFormel
Else
text = text & vbLf & "Bed " & I & ": " & BedType & " " & BedOperator & " " & BedFormel
End If
Next
wks2.Range(Zelle.Address).Value = text
End If
Next
wks2.UsedRange.Columns.ColumnWidth = 30
wks2.UsedRange.WrapText = True
End Sub