bedingte Formatierung auslesen
28.02.2009 21:05:52
Reinhard
Hallo Jörg,
vielleicht existiert im Internet schon fertiger Code der alle Möglichkeiten der bed. Formatierung abdeckt.
Du könntest ja mal nach markanten Codebefehlen der hiesigen Codes googeln.
add, formatconditions usw.
Diese Worte müssen ja in so einem Code vorkommen *denk*
Nachfolgend der Teilcode eines größeren Projekts was Jeannie ersetzt für ein Forum wo Jeannie nicht
funktioniert.
(jeannie siesht du hier oft wenn hier in Beiträgen Tabellenbereiche dargestellt werden, da ist dann immer
ein Link zu Jennie dabei falls du nicht weißt was Jeannie ist.
Mit dem nachfolgenden Code werden die bedingten Formatierungen eines Zellenbereiches ausgelesen.
Vielleicht nützt dir das ja was. Zumindest erkennst du ja daß es pronzipiell nicht schwierig ist alle bed.
Formatierungen auszulesen, aber halt sehr aufwändig alle Möglichkeiten abzudecken.
In deinem Fall weißt du ja welche bed. Formatierngen du beutzt hast , kannst also paar Möglichkeiten die
du gar nicht hast weglassen, macht den Code kürzer.
Gruß
Reinhard
Option Explicit
Public BF As String, Zelle As Range, i As Byte
Sub BedingteFormatierungEinlesen()
' Code in diesem Modul weitestgehend entwickelt von Ypsilon (Micha)
BF = "Bedingte Formatierung(en):" & vbLf
If Selection.FormatConditions.Count = 0 Then GoTo Ende
For Each Zelle In Selection
Zelle.Select
For i = 1 To Zelle.FormatConditions.Count
BF = BF & Zelle.Address(0, 0) & ": "
With Zelle.FormatConditions.Item(i)
If .Type = 1 Then
BF = BF & "Zellwert ist "
Select Case .Operator
Case 1
BF = BF & "zwischen "
BF = BF & .Formula1 & " und "
BF = BF & .Formula2 & vbLf
erfüllte_bedingung
Case 2
BF = BF & "nicht zwischen "
BF = BF & .Formula1 & " und "
BF = BF & .Formula2 & vbLf
erfüllte_bedingung
Case 3
BF = BF & "gleich "
BF = BF & .Formula1 & " "
erfüllte_bedingung
Case 4
BF = BF & "ungleich "
BF = BF & .Formula1 & " "
erfüllte_bedingung
Case 5
BF = BF & "größer "
BF = BF & .Formula1 & " "
erfüllte_bedingung
Case 6
BF = BF & "kleiner "
BF = BF & .Formula1 & " "
erfüllte_bedingung
Case 7
BF = BF & "größer gleich "
BF = BF & .Formula1 & " "
erfüllte_bedingung
Case 8
BF = BF & "kleiner gleich "
BF = BF & .Formula1 & " "
erfüllte_bedingung
End Select
ElseIf .Type = 2 Then
BF = BF & "Formel ist "
BF = BF & .Formula1 & vbLf
erfüllte_bedingung
Else
MsgBox "Unbekannter Typ: " & .Type & vbLf & "Admin anrufen!"
Exit Sub
End If
End With
Next
Next Zelle
Ende:
End Sub
Sub BedingteFormatierungEinlesen2()
If Selection.FormatConditions.Count = 0 Then Exit Sub
BF = "Bedingte Formatierung:" & vbLf
For Each Zelle In Selection
For i = 1 To Zelle.FormatConditions.Count
BF = BF & Zelle.Address(0, 0) & ": "
With Zelle.FormatConditions.Item(i)
Select Case .Type
Case 1
BF = BF & "Zellwert ist "
Nummer = .Operator
Case 2
BF = BF & "Formel ist "
Nummer = 9
Case Else
MsgBox "papst anbeten"
Exit Sub
End Select
End With
Call FormatFormel(Nummer, .Formula1, .Formula2)
Call erfüllte_bedingung
Next i
Next Zelle
End Sub
Sub erfüllte_bedingung()
With Zelle.FormatConditions.Item(i).Interior
'Farbe
If Not .ColorIndex = Empty Then BF = BF & "Bei erfüllter Bedingung wird die Zelle " & Zelle. _
Address(0, 0) & " mit dem Colorindex " & .ColorIndex & " eingefärbt" & vbLf
'Muster
If Not .Pattern = Empty Then BF = BF & "Bei erfüllter Bedingung wird die Zelle " & Zelle. _
Address(0, 0) & " mit dem Muster " & .Pattern & " versehen" & vbLf
'Musterfarbe
If Not .PatternColorIndex = Empty Then BF = BF & "Bei erfüllter Bedingung wird das _
Zellenmuster " & Zelle.Address(0, 0) & " mit der Farbe " & .PatternColorIndex & " versehen" & vbLf
End With
With Zelle.FormatConditions.Item(i).Font
'Schriftfarbe -4105=Automatische farbe
If Not .ColorIndex = Empty Then BF = BF & "Bei erfüllter Bedingung wird die Zellenschrift _
in " & Zelle.Address(0, 0) & " mit der Schriftfarbe " & .ColorIndex & " eingefärbt" & vbLf
'Schriftart
If Not .Name = Empty Then BF = BF & "Bei erfüllter Bedingung wird die Zelle " & Zelle. _
Address(0, 0) & " mit dem Font " & .Name & " versehen" & vbLf
'Schriftstärke
If Not .FontStyle = Empty Then BF = BF & "Bei erfüllter Bedingung wird die Zelle " & Zelle. _
Address(0, 0) & " mit der Schriftstärke " & .FontStyle & " versehen" & vbLf
'Schriftgrösse
If Not .Size Then BF = BF & "Bei erfüllter Bedingung wird die Zelle " & Zelle.Address(0, 0) _
& " mit der Schriftgrösse " & .Size & " versehen" & vbLf
End With
With Selection.FormatConditions(i).Borders(xlLeft)
If Not .LineStyle = Empty Then BF = BF & "Bei erfüllter Bedingung erhält die Zelle " & _
Zelle.Address(0, 0) & " links eine " & Linienart(.LineStyle) & "-Linie in der Breite " & Liniendicke(.Weight) & " mit Farbe " & .ColorIndex & vbLf
End With
With Selection.FormatConditions(i).Borders(xlRight)
If Not .LineStyle = Empty Then BF = BF & "Bei erfüllter Bedingung erhält die Zelle " & _
Zelle.Address(0, 0) & " rechts eine " & Linienart(.LineStyle) & "-Linie in der Breite " & Liniendicke(.Weight) & " mit Farbe " & .ColorIndex & vbLf
End With
With Selection.FormatConditions(i).Borders(xlTop)
If Not .LineStyle = Empty Then BF = BF & "Bei erfüllter Bedingung erhält die Zelle " & _
Zelle.Address(0, 0) & " oben eine " & Linienart(.LineStyle) & "-Linie in der Breite " & Liniendicke(.Weight) & " mit Farbe " & .ColorIndex & vbLf
End With
With Selection.FormatConditions(i).Borders(xlBottom)
If Not .LineStyle = Empty Then BF = BF & "Bei erfüllter Bedingung erhält die Zelle " & _
Zelle.Address(0, 0) & " unten eine " & Linienart(.LineStyle) & "-Linie in der Breite " & Liniendicke(.Weight) & " mit Farbe " & .ColorIndex & vbLf
End With
'noch offen :-( gibt es die Möglichkeiten alle ? *grummel*
' With Selection.Font
' .Strikethrough = False
' .Superscript = False
' .Subscript = False
' .OutlineFont = False
' .Shadow = False
' .Underline = xlUnderlineStyleNone
' End With
End Sub
Sub FormatFormel(ByVal Nummer As Byte, ByVal Bed1, Optional ByVal Bed2)
On Error GoTo Fehler
Dim Wahl, Zelle, N
Wahl = Array("Dummy", "zwischen", "nicht zwischen", "gleich", "ungleich", "größer", "kleiner", " _
größer gleich", "kleiner gleich", "Formel ist")
Select Case Nummer
Case 1, 2
BF = BF & Wahl(Nummer) & Bed1 & "und" & Bed2 & vbLf
Case 3 To 9
BF = BF & Wahl(Nummer) & Bed1 & vbLf
Case Else
MsgBox "papst anbeten"
End Select
Exit Sub
Fehler:
MsgBox "bla"
End Sub
Function Liniendicke(ByVal Nummer) As String
'xlHairline, xlThin, xlMedium oder xlThick. Long Schreib-Lese-Zugriff.
Select Case Nummer
Case 1
Liniendicke = "xlHairline"
Case 2
Liniendicke = "xlThin"
Case -4138
Liniendicke = "xlMedium"
Case 4
Liniendicke = "xlxlThick"
Case Else
MsgBox "Fehler mit Liniendicke"
End Select
End Function
Function Linienart(ByVal Nummer) As String
Select Case Nummer
Case 1
Linienart = "xlContinuous"
Case -4115
Linienart = "xlDash"
Case 4
Linienart = "xlDashDot"
Case 5
Linienart = "xlDashDotDot"
Case -4118
Linienart = "xlDot"
Case -4119
Linienart = "xlDouble"
Case 13
Linienart = "xlSlantDashDot"
Case -4142
Linienart = "xlLineStyleNone"
Case Else
MsgBox "Fehler mit Linienart"
End Select
End Function