VBA Probleme beim Umstieg 2003 auf 2007 Teil 2
23.06.2014 13:59:32
Matthias
Ich habe in Excel2003 Zellen über bedingtes Formatieren farbig markiert
Hellgelb wenn eine Zelle zu bearbeiten ist
Rot wenn ein Fehler beim ausfüllen gemacht wurde.
Beim generieren des Inhaltsverzeichnis habe ich nach diesen Bedingten Farbformaten gesucht und diese zum Inhaltverzeichnis hinzugefügt so konnte man direkt auf das Blatt mit dem Fehler gehen(Sprungadresse über Hyperlink) und den Fehler Korrigieren.
In 2007 erkennt es diese Farben nicht mehr Mal nimmt es sie richtig mal nimmt es irgend ein Grauton. Muss ich jetzt alle bedingten Formatierungen auf die neuen 2007ner Farben umstellen oder gibt es irgend eine Anweisung die diese Farben richtig erkennt.
Teile aus VBA:
' Farbbestimmung
For Spalte = 1 To 10
For Zeile = 2 To 100
Farbe = ColorOfCF(ActiveSheet.Cells(Zeile, Spalte), False)
If Farbe = 10092543 Then
Farbeneu = 10092543
TextNeu = "Sie haben noch nicht alle Mussfelder ausgefüllt"
End If
If Farbe = 255 Then
Farbeneu = 255
TextNeu = "Sie haben ein Fehler gemacht"
Exit For
End If
Next Zeile
If Farbe = 255 Then
Exit For
End If
Next Spalte
Den Farbcode habe ich mir über eine Procedur geschrieben
Public Sub Farbbestimmung()
Worksheets("Farbtabelle").Activate
For Zeile = 1 To 40
Cells(Zeile, 1).Select
Farbe = Selection.Interior.Color
Cells(Zeile, 2) = Farbe
Next Zeile
End Sub
***********************************************************************************
Die Funktionen hat mein Kollege damals bereits angefragt. Sind leider nicht von mir
***********************************************************************************
Function GetStrippedValue(CF As String) As String
Dim Temp As String
If InStr(1, CF, "=", vbTextCompare) Then
Temp = Mid(CF, 3, Len(CF) - 3)
If Left(Temp, 1) = "=" Then
Temp = Mid(Temp, 2)
End If
Else
Temp = CF
End If
GetStrippedValue = Temp
End Function
Function GetCFCondition(cell As Range) As Integer
Dim myVal, eval_1, eval_2
Dim i As Integer
Dim done As Boolean
GetCFCondition = 0
cell(1).Select ' der muß wohl leider sein :-(
myVal = cell(1).Value ' Der Wert der Zelle
For i = 1 To cell.FormatConditions.Count
With cell.FormatConditions.Item(i)
' Anders habe ich es nicht hinbekommen!
' Den ReferenceStyle mußte ich umbiegen damit
' Names.Add RefersToR1C1Local & Evalute funktionieren
' ein simples Evaluate(.Formula1) SCHEITERT, falls dort
' eine Formel mit Namen steht, z.B.: SUMME
' dieser Name ist hier nämlich lokalisiert, evaluate selber
' funktioniert aber nur mit englischem SUM !!!
Application.ReferenceStyle = xlR1C1
'cell.FormulaLocal = .Formula1
On Error Resume Next
Names.Add Name:="testname_1", RefersToR1C1Local:=.Formula1
Names.Add Name:="testname_2", RefersToR1C1Local:=.Formula2
eval_1 = Evaluate("testname_1")
eval_2 = Evaluate("testname_2")
Names("testname_1").Delete
Names("testname_2").Delete
Application.ReferenceStyle = xlA1
' Hier erfolgt dann die eigentliche Unterscheidung
If .Type = 1 Then
Select Case .Operator
Case xlBetween
done = (myVal >= eval_1 And myVal
(myVal >= eval_2 And myVal
Case xlEqual
done = myVal = eval_1
Case xlGreater
done = myVal > eval_1
Case xlGreaterEqual
done = myVal >= eval_1
Case xlLess
done = myVal
Case xlLessEqual
done = myVal
Case xlNotBetween
done = (myVal
(myVal > eval_1 And myVal > eval_2)
Case xlNotEqual
done = myVal eval_1
Case Else
MsgBox "Unbekannter Operator: " & .Operator, , "PANIC: In Function GetCFCondition"
Exit Function
End Select
ElseIf .Type = 2 Then
done = eval_1 = True
Else
MsgBox "Unbekannter Typ: " & .Type, , "PANIC: In Function GetCFCondition"
Exit Function
End If
On Error GoTo 0
If done Then ' wir haben fertig
GetCFCondition = i
Exit Function
End If
End With
Next
End Function
Function ColorOfCF(Rng As Range, Optional OfText As Boolean = False) As Long
Dim AC As Integer
AC = GetCFCondition(Rng)
If AC = 0 Then
If OfText = True Then
ColorOfCF = Rng.Font.Color
Else
ColorOfCF = Rng.Interior.Color
End If
Else
If OfText = True Then
ColorOfCF = Rng.FormatConditions(AC).Font.Color
Else
ColorOfCF = Rng.FormatConditions(AC).Interior.Color
End If
End If
End Function