Methode 'Farbe' des Objekts 'Schriftart' fehlgeschlagen

Question

Ich erhalte die Titelfehlermeldung in meinem Excel 2010 VBA-Code. Ich habe this question und this question betrachtet, die beide ähnlich aussehen, aber unterer scheint das Problem anzusprechen.

Mein Code analysiert durch alle bedingte Formatierung auf dem aktuellen Arbeitsblatt und gibt sie als Text in einer anderen (neu geschaffenen) Arbeitsblatt - das ultimative Ziel ist es, die gleichen Bedingungen zu einem fast identisch Arbeitsblatt zu laden (also kann ich‘ t einfach das Basisarbeitsblatt kopieren).

Der Code ist:

Public Sub DumpExistingRules() 
'portions of the code from here: http://dailydoseofexcel.com/archives/2010/04/16/listing-format-conditions/ 

Const RuleSheetNameSuffix As String = "-Rules" 

    Dim TheWB As Workbook 
    Set TheWB = ActiveWorkbook 

    Dim SourceSheet As Worksheet 
    Set SourceSheet = TheWB.ActiveSheet 

    Dim RuleSheetName As String 
    RuleSheetName = SourceSheet.Name & RuleSheetNameSuffix 
    On Error Resume Next       'if the rule sheet doesn't exist it will error, we don't care, just move on 
    Application.DisplayAlerts = False 
    TheWB.Worksheets(RuleSheetName).Delete 
    Application.DisplayAlerts = True 
    On Error GoTo EH 

    Dim RuleSheet As Worksheet 
    Set RuleSheet = TheWB.Worksheets.Add 
    SourceSheet.Activate 
    RuleSheet.Name = RuleSheetName 

    RuleSheet.Range(RuleSheet.Cells(1, CellAddrCol), RuleSheet.Cells(1, OperatorCodeCol)).Value = Array("Cell Address", "Rule Type", "Type Code", "Applies To", "Stop", "Font.ColorRGB", "Formula1", "Formula2", _ 
      "Interior.ColorIndexRGB", "Operator Type", "Operator Code") 

    Dim RuleRow As Long 
    RuleRow = 2 
    Dim RuleCount As Long 
    Dim RptCol As Long 
    Dim SrcCol As Long 
    Dim RetryCount As Long 
    Dim FCCell As Range 
    For SrcCol = 1 To 30 
    Set FCCell = SourceSheet.Cells(4, SrcCol) 
    For RuleCount = 1 To FCCell.FormatConditions.Count 
     RptCol = 1 
     Application.StatusBar = "Cell: " & FCCell.Address 
     PrintValue RuleSheet, RuleRow, CellAddrCol, FCCell.Address 
     PrintValue RuleSheet, RuleRow, RuleTypeCol, FCTypeFromIndex(FCCell.FormatConditions.Item(RuleCount).Type) 
     PrintValue RuleSheet, RuleRow, RuleCodeCol, FCCell.FormatConditions.Item(RuleCount).Type 
     PrintValue RuleSheet, RuleRow, AppliesToCol, FCCell.FormatConditions.Item(RuleCount).AppliesTo.Address 
     PrintValue RuleSheet, RuleRow, StopCol, FCCell.FormatConditions.Item(RuleCount).StopIfTrue 
     If FCCell.FormatConditions.Item(RuleCount).Type <> 8 Then 
     PrintValue RuleSheet, RuleRow, Formula1Col, "'" & Right(FCCell.FormatConditions.Item(RuleCount).Formula1, Len(FCCell.FormatConditions.Item(RuleCount).Formula1) - 1) 'remove the leading "=" sign 
     If FCCell.FormatConditions.Item(RuleCount).Type <> 2 And _ 
      FCCell.FormatConditions.Item(RuleCount).Type <> 1 Then 
      PrintValue RuleSheet, RuleRow, Formula2Col, "'" & Right(FCCell.FormatConditions.Item(RuleCount).Formula2, Len(FCCell.FormatConditions.Item(RuleCount).Formula2) - 1) 'remove the leading "=" sign 
     End If 
     End If 
     RetryCount = 0 
RetryColor: 
     PrintValue RuleSheet, RuleRow, FontColorCol, "'" & GetRGB(FCCell.FormatConditions(RuleCount).Font.Color) 
     PrintValue RuleSheet, RuleRow, IntColorIdxCol, "'" & GetRGB(FCCell.FormatConditions.Item(RuleCount).Interior.Color) 
     If FCCell.FormatConditions.Item(RuleCount).Type = 1 Then 
     PrintValue RuleSheet, RuleRow, OperatorTypeCol, OperatorType(FCCell.FormatConditions.Item(RuleCount).Operator) 
     PrintValue RuleSheet, RuleRow, OperatorCodeCol, FCCell.FormatConditions.Item(RuleCount).Operator 
     End If 
     RuleRow = RuleRow + 1 
    Next 
    Next 

    RuleSheet.Rows(1).AutoFilter = True 

CleanExit: 
    If RuleRow = 2 Then 
    PrintValue RuleSheet, RuleRow, RptCol, "No Conditional Formatted cells were found on " & SourceSheet.Name 
    End If 
    On Error Resume Next 
    Set SourceSheet = Nothing 
    Set TheWB = Nothing 
    Application.StatusBar = "" 
    On Error GoTo 0 

    MsgBox "Done" 

    Exit Sub 

EH: 
    If Err.Number = -2147417848 Then 
    MsgBox "Font.Color = " & FCCell.FormatConditions(RuleCount).Font.Color 
    If RetryCount < 5 Then 
     RetryCount = RetryCount + 1 
     Resume RetryColor 
    Else 
     MsgBox "RetryCount = " & RetryCount 
     Resume Next 
    End If 
    Else 
    MsgBox "Error Number: " & Err.Number & vbCrLf & _ 
      " Description: " & Err.Description & vbCrLf & _ 
      "Cell Address: " & FCCell.Address & vbCrLf 
    Resume Next 
    End If 

End Sub 

Die Linie in Frage die man sofort ist nach dem RetryColor: Label. Wenn diese Codezeile für eine bedingte Formatierungsregel Unique Values ausgeführt wird (d. H. Duplikate hervorheben), erhalte ich err.number = -2147417848' und err.description = "Method 'Color' of object 'Font' failed". Der Code fällt auf EH:, fällt in die erste IF Anweisung und zeigt die MsgBox ohne jedes Problem an.

Warum ist die Anweisung FCCell.FormatConditions(RuleCount).Font.Color das erste Mal fehlgeschlagen, aber das zweite Mal im Fehlerbehandler einwandfrei ausgeführt? Sobald ich die OK Schaltfläche auf der MsgBox geklickt habe, wird die Ausführung unter der RetryColor: Beschriftung fortgesetzt, die Anweisung wird ordnungsgemäß ausgeführt und alles ist gut.

---

---

Um sicherzustellen, dass dies klar ist, wenn ich die in EH:

MsgBox "Font.Color = " & FCCell.FormatConditions(RuleCount).Font.Color 

Zeilen aus kommentieren, wird der Code 5 mal Fehler, ohne jemals den RGB-Code zu meinem Ausgang Arbeitsblatt ausgeben, dann weiter auf seinem Weg. Wenn diese Zeile in EH: ist (wie oben gezeigt), bekomme ich die MsgBox und die .Font.Color wird jetzt im Hauptcode gelesen und die Ausführung wird wie erwartet ohne Fehler fortgesetzt.

---

---

UPDATE: Es scheint, dass dieser Code nach dem Loslassen eine Woche lang zu sitzen, während ich auf etwas anderes gearbeitet, dass es jetzt etwas mehr gebrochen ist. Im Fehlerhandler bekomme ich jetzt die titular error message popping, up. Wenn ich F5 drücke, wird es die MsgBox mit dem Farbcode ausführen und anzeigen.

Jetzt wird es zweimal fehlschlagen, dann die 3 ^rd Zeit ordnungsgemäß ausführen.

---

Der Vollständigkeit halber ist hier der Code für GetRGB:

Private Function GetRGB(ByVal ColorCode As Variant) As String 

    Dim R As Long 
    Dim G As Long 
    Dim B As Long 

    If IsNull(ColorCode) Then 
    GetRGB = "0,0,0" 
    Else 
    R = ColorCode Mod 256 
    G = ColorCode \ 256 Mod 256 
    B = ColorCode \ 65536 Mod 256 

    GetRGB = R & "," & G & "," & B 
    End If 

End Function 

Ich habe den Parameter als Variant passieren, weil, wenn die .Font.Color zu Automatic in der Farbauswahl gesetzt ist, bekomme ich ein NULL zurückgeführt, wodurch die If Aussage in GetRGB.

Ein weiteres Update: Nachdem ich diesen Code für ein paar Wochen gelassen habe (es ist mein Leben leichter zu machen, kein offizielles Projekt, deshalb steht er ganz unten auf der Prioritätenliste), scheint es das zu generieren Fehler bei jedem Anruf jetzt statt nur manchmal.Jedoch, wird der Code ordnungsgemäß im unmittelbaren Fenster ausgeführt werden!

Die gelb markierte Zeile derjenige ist, der den Fehler verursacht hat, aber Sie können die Ergebnisse in dem sofortigen Fenster sehen.

---

auch (ich weiß, das ist wirklich eine andere Frage sein sollte), wenn jemand schnell passiert, für die Linie SourceSheet.Activate keinen Grund, um zu sehen, lassen Sie es mich wissen - ich war immer zufällige Fehler ohne es, so habe ich, dass in In der Regel sind diese Fehler auf unqualifizierte Referenzen zurückzuführen, die auf dem gerade aktiven Blatt arbeiten (das wäre RuleSheet, sobald es erstellt wurde), aber ich dachte, ich hätte alle meine Referenzen qualifiziert. Wenn Sie etwas sehen, das ich vermisst habe, bitte pipen! Ansonsten werde ich wahrscheinlich zu CodeReview gehen, damit sie einen Blick darauf werfen, was ich verpasst habe, sobald ich das richtig funktioniert habe.

Answer 1

Ihre zweite Frage zu:
ich immer Probleme gehabt habe, mit späteren Zellen, die nicht in einem aktiven Blatt, die wahrscheinlichste Ursache für das Problem in SourceSheet.Activate tun beruht auf der Tatsache, dass der Set Einstellbereich:

Set FCCell = SourceSheet.Cells(4, SrcCol) 

ich habe festgestellt, dass, wenn das Blatt nicht aktiv ist, es innerhalb der Zellen() Argument fehlschlagen würde, glaube ich, der beste Ansatz für diesen Bereich wird mit bevor Zellen.
This may be the case. So für dieses Beispiel würde ich so etwas wie:

With SourceSheet:Set FCCell = .Range(.Cells(4,SrcCol):End With 

Answer 2

Ich glaube, ich diese Ursache zu einer Wurzel reduziert haben.

Ich habe manuell 2 verschiedene Arten von FormatConditions in Zelle Sheet1.A1:

Und hier ist mein Code in derselben Arbeitsmappe.

Sub foo() 

    Dim rng As Range 
    Set rng = Sheet1.Range("A1") 

    Dim fc As Object 
    On Error Resume Next 

    Sheet2.Activate 
    Set fc = rng.FormatConditions(1) 
    Debug.Print ActiveSheet.Name, TypeName(fc), fc.Type 
    Debug.Print , fc.Font.Color 
    Set fc = rng.FormatConditions(2) 
    Dim fnt As Font2 
    Debug.Print ActiveSheet.Name, TypeName(fc), fc.Type 
    Debug.Print , fc.Font.Color 

    Sheet1.Activate 
    Set fc = rng.FormatConditions(1) 
    Debug.Print ActiveSheet.Name, TypeName(fc), fc.Type 
    Debug.Print , fc.Font.Color 
    Set fc = rng.FormatConditions(2) 
    Debug.Print ActiveSheet.Name, TypeName(fc), fc.Type 
    Debug.Print , fc.Font.Color 

End Sub 

Und hier ist der Ausgang:

Sheet2 FormatCondition 1 
     3243501 
Sheet2 Top10    5 
Sheet1 FormatCondition 1 
     3243501 
Sheet1 Top10    5 
     13998939 

So ist die FormatConditions.Item Methode nicht immer zurückgeben ein FormatCondition

Ich kann Ihr Direkt-Fenster Verhalten nicht reproduzieren, vielleicht versehentlich Sie das Blatt aktiviert ?

Wenn ich die On Error Resume entfernen und brechen an der Fehler für den Top10.Font.Color Anruf, und dann im Debug-Fenster abfragen, erhalte ich:

Laufzeitfehler '-2147417848 (80010108)':

Automatisierungsfehler Das aufgerufene Objekt wurde von seinen Clients getrennt.

Für welche Google mich

Aufgrund meiner Ergebnisse Error or Unexpected Behavior with Office Automation When You Use Early Binding in Visual Basic nimmt, wenn die FormatConditions.Item kehrt ein Top10 (und vielleicht auch andere Arten, einschließlich Ihrer UniqueValues Typ), ist es nicht möglich, die Font.Color Eigenschaft zuzugreifen es sei denn, das Blatt des Bereichs ist aktiv.

Aber es sieht so aus, als ob Sie es aktiv haben? Ich frage mich, ob Sie das aktive Blatt in PrintValue ändern?