Metoda "Kolor" obiektu "Czcionka" nie powiodła się

Question

Otrzymuję komunikat o błędzie tytuł w moim kodu VBA Excel 2010. Przyjrzałem się this question i this question, które wyglądają podobnie, ale wydaje się, że nether rozwiązuje ten problem.

Mój kod analizuje przez cały formatowania warunkowego na bieżącym arkuszu i zrzuca go jako tekst do innego (nowo utworzone) arkuszu - ostatecznym celem jest, aby załadować te same warunki do prawie identycznym arkuszu (w ten sposób mogę” t po prostu skopiuj podstawowy arkusz roboczy).

Kod jest:

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 

Linia w pytaniu jest jeden bezpośrednio po etykiecie RetryColor:. Kiedy ta linia kodu jest wykonywana dla reguły warunkowego formatowania Unique Values (tj. Zaznacza duplikaty), otrzymuję err.number = -2147417848' i err.description = "Method 'Color' of object 'Font' failed". Kod spada do EH:, wchodzi w pierwsze oświadczenie IF i wyświetla bez żadnych problemów MsgBox.

Dlaczego za pierwszym razem nie powiedzie się instrukcja FCCell.FormatConditions(RuleCount).Font.Color, ale po raz drugi wykonuje się ją po raz drugi w procedurze obsługi błędów? Po kliknięciu przycisku OK na MsgBox, wznowienie wykonywania na etykiecie RetryColor:, instrukcja jest wykonywana poprawnie, a wszystko jest w porządku.

---

---

Aby upewnić się, to jest jasne, czy mogę wypowiedzieć się linię

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

w EH:, kod będzie Błąd 5 razy, nigdy nie wpisywanie kodu RGB do mojego wyjścia arkusza, a następnie kontynuować na jej droga. Jeśli linia ta jest w EH: (jak pokazano powyżej), otrzymam MsgBox i .Font.Color zostanie teraz odczytany w głównym kodzie i wykonanie będzie kontynuowane zgodnie z oczekiwaniami bez błędu.

---

---

UPDATE: Wydaje się, że po wpuszczeniu ten kod siedzieć przez tydzień, a ja pracowałem na coś innego, że to teraz lekko więcej złamany. W procedurze obsługi błędów dostaję teraz komunikat o błędzie tytułowy. Jeśli uderzę F5, wykona i wyświetli MsgBox z kodem koloru.

Teraz dwa razy zakończy się niepowodzeniem, a następnie prawidłowo wykona czas 3 ^rd.

---

Dla kompletności, oto kod dla 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 

muszę przekazać parametr jako Variant bo gdy .Font.Color jest ustawiony na Automatic w oknie wyboru koloru, otrzymuję NULL wrócił, więc stwierdzenie If w GetRGB.

Kolejna aktualizacja Po pozwalając ten kod siedzieć przez kilka tygodni (to, aby moje życie łatwiejszym, a nie oficjalny projekt, dlatego to na dole listy priorytetów), wydaje się, że będzie on wygenerować błąd przy każdym połączeniu teraz, zamiast po prostu czasami.Jednak, kod zostanie wykonany poprawnie w bezpośrednim oknie!

Żółty podświetlona linia jest jeden, który wygenerował błąd, ale można zobaczyć wyniki w najbliższym oknie.

---

także (zdaję sobie sprawę, to naprawdę powinien być kolejne pytanie), jeśli ktoś dzieje się szybko widzę żadnego powodu, dla linii SourceSheet.Activate, proszę dać mi znać - ja trafiałem przypadkowych błędów bez, więc stawiam, że w Zwykle te błędy wynikają z niewykwalifikowanych odnośników pracujących na aktualnie aktywnym arkuszu (który byłby RuleSheet jak tylko zostanie utworzony), ale myślałem, że mam wszystkie moje referencje. Jeśli zauważysz coś, co przegapiłem, potwierdź! W przeciwnym razie prawdopodobnie przejdę do CodeReview, aby zobaczyć, co przeoczyłem, gdy sprawię, że działa prawidłowo.

Answer 1

Odnośnie drugiego pytania:
zawsze mieli problemy z ustawieniem komórek, które nie są w aktywnym arkuszu, najbardziej prawdopodobną przyczyną problemu w ten SourceSheet.Activate opiera się na fakcie zakresu późniejszy:

Set FCCell = SourceSheet.Cells(4, SrcCol) 

Znalazłem, że jeśli arkusz nie jest aktywny, to nie w komórkach() argument, myślę, że najlepszym sposobem na to jest za pomocą Zakres przed komórkami.
This may be the case. Więc w tym przykładzie chciałbym zrobić coś takiego:

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

Answer 2

Chyba zredukowane do tego przyczynę.

ręcznie dodane 2 różne rodzaje FormatConditions w komórce Sheet1.A1:

i tu jest mój kod, w tym samym skoroszycie.

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 

A oto wyjście:

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

Więc metoda FormatConditions.Item nie zawsze zwracają FormatCondition

I nie można odtworzyć natychmiastowej zachowania okien, więc może przypadkowo aktywowane arkusz ?

Jeśli usunąć On Error Resume i złamać przy błędu dla wywołania Top10.Font.Color, a następnie kwerendy w oknie debugowania, otrzymuję:

Run-time error '-2147417848 (80010108)':

Błąd automatyzacji Wywołany obiekt odłączył się od klientów.

Dla których Google bierze mnie do Error or Unexpected Behavior with Office Automation When You Use Early Binding in Visual Basic

oparciu o moje wyniki, gdy FormatConditions.Item Zwraca Top10 (i być może innych typów, w tym typu UniqueValues), nie ma możliwości dostępu do właściwości Font.Color, chyba że arkusz zakresu to aktywny.

Ale wygląda na to, że jest aktywny? Zastanawiam się, czy zmieniasz aktywny arkusz w PrintValue?