Question

我有一个程序应检查选定单元格的背景颜色，并根据颜色输出一个值，然后为文本着色以匹配背景。

但是，每次运行此过程时，都会出现以下错误。这也导致Excel冻结，这意味着我必须关闭并重新打开它（只是结束宏不会停止该行为） -

运行时错误'-2147417847（80010108）'：
对象'Font'的方法'ThemeColor'失败

任何人都可以帮我找到我做错的事吗？感谢。

Private Sub AssignBackgroundValue(ByVal Target As Range)

    Dim val As Integer

    Dim c As Range
    For Each c In Target.Cells

        With c.Interior

            Select Case Target.Interior.ThemeColor
                Case xlThemeColorAccent6
                    val = 1
                Case xlThemeColorAccent5
                    val = 2
                Case xlThemeColorAccent4
                    val = 3
                Case xlThemeColorAccent3
                    val = 4
                Case xlThemeColorAccent2
                    val = 5
                Case xlThemeColorDark1
                    val = 6
                Case xlThemeColorLight1
                    val = 7
            End Select

            c.Font.ThemeColor = IIf(VarType(.ThemeColor) = vbLong, .ThemeColor, 0)
            c.Font.TintAndShade = IIf(VarType(.TintAndShade) = vbDouble, .TintAndShade, 0)

        End With

        c.value = val

    Next

End Sub

Answer 1

您需要考虑使用标准颜色而不填充的情况：

Private Sub AssignBackgroundValue(ByVal Target As Range)
    Dim val As Integer

    Dim c As Range
    For Each c In Target.Cells

        With c.Interior
            If IsError(Target.Interior.ThemeColor) Then
                c.Font.PatternTintAndShade = 0
            Else
                Select Case Target.Interior.ThemeColor
                    Case xlThemeColorAccent6
                        val = 1
                    Case xlThemeColorAccent5
                        val = 2
                    Case xlThemeColorAccent4
                        val = 3
                    Case xlThemeColorAccent3
                        val = 4
                    Case xlThemeColorAccent2
                        val = 5
                    Case xlThemeColorDark1
                        val = 6
                    Case xlThemeColorLight1
                        val = 7
                    Case 0
                        val = 0
                End Select

                If val <> 0 Then
                    c.Font.ThemeColor = IIf(VarType(.ThemeColor) = vbLong, .ThemeColor, 0)
                Else
                    c.Font.Color = IIf(VarType(.ThemeColor) = vbLong, .Color, 0)
                End If
                c.Font.TintAndShade = IIf(VarType(.TintAndShade) = vbDouble, .TintAndShade, 0)
            End If
        End With

        c.Value = val
    Next
End Sub

当VBA尝试更改字体主题颜色时Excel崩溃

1 个答案: