excel - 对象 'Color' 的方法 'Font' 失败

Question

我在 Excel 2010 VBA 代码中收到标题错误消息。我看过this question和 this question两者看起来很相似，但似乎都没有解决这个问题。

我的代码解析当前工作表上的所有条件格式并将其作为文本转储到另一个(新创建的)工作表 - 最终目标是将这些相同的条件加载到几乎相同的工作表(因此我不能只复制基本工作表)。

代码是:

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

相关行是紧随 RetryColor: 标签的行。当针对 Unique Values 条件格式规则(即突出显示重复项)执行该行代码时，我得到 err.number = -2147417848' 和 err.description =“对象‘字体’的方法‘颜色’失败”。代码落入 EH:，落入第一个 IF 语句，并毫无问题地显示 MsgBox。

为什么语句 FCCell.FormatConditions(RuleCount).Font.Color 第一次失败，但第二次在错误处理程序中完美执行？？单击 MsgBox 上的 OK 按钮后，执行将在 RetryColor: 标签处恢复，语句正确执行，一切都很好.

---

---

为了确保这一点清楚，如果我注释掉

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

EH: 中的行，该代码将错误 5 次，而不会将 RGB 代码输出到我的输出工作表，然后继续运行。如果该行位于 EH: 中(如上所示)，我会得到 MsgBox 和 .Font.Color > 现在将在主代码中读取，并且执行将按预期继续，不会出现错误。

---

---

更新:似乎在让这段代码放置一周而我在处理其他事情之后，它现在有点更多损坏了。在错误处理程序中，我现在弹出标题错误消息。如果我点击F5，它将执行并显示带有颜色代码的MsgBox。

所以现在，它会失败两次，然后第三次正确执行。

---

为了完整起见，以下是 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

我必须将参数作为 Variant 传递，因为当 .Font.Color 在颜色选择器中设置为 Automatic 时，我返回一个 NULL，即 GetRGB 中的 If 语句。

另一个更新:让这段代码再放置几周后(这是为了让我的生活更轻松，不是官方项目，因此它位于优先级列表的底部)，似乎现在，它会在每次调用时生成错误，而不是有时。 但是，代码将在立即窗口中正确执行!

黄色突出显示的行是生成错误的行，但您可以在立即窗口中看到结果。

---

另外(我意识到这确实应该是另一个问题)，如果有人碰巧很快看到 SourceSheet.Activate 行的任何原因，请告诉我 -没有它，我就会遇到随机错误，所以我将其放入。通常这些错误是由于在当前事件工作表上工作的不合格引用(一旦出现，将是 RuleSheet)它已创建)，但我认为我的所有引用文献都是合格的。如果你看到我错过的东西，请指出!否则，一旦我让它正常工作，我可能会前往 CodeReview 让他们看看我错过了什么。

Answer 1

我想我已经将此问题归结为根本原因。

我在单元格 Sheet1.A1 中手动添加了 2 种不同类型的 FormatConditions:

这是我的代码，位于同一工作簿中。

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

这是输出:

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

因此 FormatConditions.Item 方法并不总是返回 FormatCondition

我无法重现您的立即窗口行为，所以也许您无意中激活了工作表？

如果我删除On Error Resume，并在Top10.Font.Color调用的错误处中断，然后在调试窗口中查询，我得到:

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

Automation error The object invoked has disconnected from its clients.

为此，Google 将我带到 Error or Unexpected Behavior with Office Automation When You Use Early Binding in Visual Basic

根据我的结果，当 FormatConditions.Item 返回 Top10 (可能还有其他类型，包括您的 UniqueValues 类型)时，它除非该范围的工作表处于事件状态，否则无法访问 Font.Color 属性。

但看起来你已经激活了？我想知道您是否要更改 PrintValue 中的事件工作表？