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

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

但是，每次运行此过程时，都会出现以下错误。这也会导致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

---

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

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

Private Sub AssignBackgroundValue（ByVal目标作为范围）
作为整数的Dim val
调光范围
对于目标单元格中的每个c
带c.内饰
如果IsError（Target.Interior.ThemeColor）则
c、 Font.PatternTintAndShade=0
其他的
选择Case Target.Interior.ThemeColor
案例xlThemeColorAccent6
val=1
案例xlThemeColorAccent5
val=2
案例四：经济舱4
val=3
案例四十主题社区3
val=4
案例四十主题主题2
val=5
案例四十经济法庭1
val=6
案例四十主题彩灯1
val=7
案例0
val=0
结束选择
如果值为0，则
c、 Font.THEMECLOR=IIf（变量类型（.THEMECLOR）=vbLong，.THEMECLOR，0）
其他的
c、 Font.Color=IIf（VarType（.ThemeColor）=vbLong.Color，0）
如果结束
c、 Font.TintAndShade=IIf（VarType（.TintAndShade）=vbDouble，.TintAndShade，0）
如果结束
以
c、 值=val
下一个
端接头

关于检查不匹配项的好观点，我已经更新为包括。但是我发现了我的问题，这个过程是由对单元格的更改触发的，然后它继续重新启动，因为我没有禁用事件（

Application.EnableEvents=False

）持续时间。任何可能遇到您答案的人的参考信息-

c.Font.TintAndShade

必须设置在

c.Font.ThemeColor

之后。