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 = "Method 'Color' of object 'Font' failed"。代码降至EH:，属于第一个IF语句，并显示MsgBox没有任何问题。

为什么语句FCCell.FormatConditions(RuleCount).Font.Color第一次失败，但第二次在错误处理程序中完美执行？一旦我点击OK上的MsgBox按钮，执行将在RetryColor:标签处继续执行，语句正确执行，一切正常。

为确保明确这一点，如果我注释掉

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

在EH:中的行，代码将错误5次，而不会将RGB代码输出到我的输出工作表，然后继续前进。如果EH:中的行（如上所示），我将获得MsgBox，现在将在主代码中读取.Font.Color并继续执行如预期没有错误。

更新：似乎在我将这段代码放置一周后，我还在处理其他内容时，现在它已经稍微更多了。在错误处理程序中，我现在得到一个标题错误消息，弹出。如果我点击 F5 ，它将执行并显示带有颜色代码的MsgBox。

现在，它将失败两次，然后正确执行3 ^rd时间。

为了完整起见，请参阅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，因此{ {1}}中的{1}}语句。

另一个更新：让这段代码再过几个星期（让我的生活变得更轻松，而不是官方项目，因此它在底部优先级列表），它似乎会在每次调用时生成错误，而不仅仅是有时。然而，代码将在即时窗口中正确执行！

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

此外（我知道这应该是另一个问题），如果有人碰巧看到If行的任何原因，请告诉我 - 我收到随机错误没有，所以我把它放进去。通常这些错误是因为在当前活动的工作表上工作的不合格的引用（一旦创建它就会GetRGB），但我以为我的所有参考资料都合格了。如果你看到我错过的东西，请管好！否则，我可能会前往CodeReview让他们看看我错过了一次，让我的工作正常。

Answer 1

我认为我已将此减少为根本原因。

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

这是我的代码，在同一个工作簿中。

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调用的错误处打破，然后在调试窗口中查询，我得到：

运行时错误'-2147417848（80010108）'：

自动化错误   调用的对象已与其客户端断开连接。

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

根据我的结果，当FormatConditions.Item返回Top10（以及其他类型，包括您的UniqueValues类型）时，无法访问Font.Color } property 除非范围的工作表活动 。

但看起来你活跃了吗？我想知道您是否正在更改PrintValue中的活动工作表？

Answer 2

关于你的第二个问题：
我一直遇到设置不在活动工作表中的单元格的问题，执行问题的最可能原因SourceSheet.Activate依赖于稍后设置范围的事实：

Set FCCell = SourceSheet.Cells(4, SrcCol)

我发现，如果工作表不活动，它将在cells（）参数中失败，我认为最好的方法是在Cells之前使用 Range 。
This may be the case。所以对于这个例子，我会做类似的事情：

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

方法＆＃39;颜色＆＃39;对象＆＃39;字体＆＃39;失败

2 个答案: