Question

我的代码是

    Sub PieMarkers()

Dim chtMarker As Chart
Dim chtMain As Chart
Dim intPoint As Integer
Dim rngRow As Range
Dim lngPointIndex As Long
Dim thmColor As Long
Dim myTheme As String


Application.ScreenUpdating = False
Set chtMarker = ActiveSheet.ChartObjects("chtMarker").Chart
Set chtMain = ActiveSheet.ChartObjects("chtMain").Chart

Set chtMain = ActiveSheet.ChartObjects("chtMain").Chart
Set rngRow = Range(ThisWorkbook.Names("PieChartValues").RefersTo)

For Each rngRow In Range("PieChartValues").Rows
    chtMarker.SeriesCollection(1).Values = rngRow
    ThisWorkbook.Theme.ThemeColorScheme.Load GetColorScheme(thmColor)
    chtMarker.Parent.CopyPicture xlScreen, xlPicture
    lngPointIndex = lngPointIndex + 1
    chtMain.SeriesCollection(1).Points(lngPointIndex).Paste
    thmColor = thmColor + 1
Next

lngPointIndex = 0

Application.ScreenUpdating = True
End Sub

Function GetColorScheme(i As Long) As String
Const thmColor1 As String = "C:\Program Files\Microsoft Office\Document Themes 15\Theme Colors\Blue Green.xml"
Const thmColor2 As String = "C:\Program Files\Microsoft Office\Document Themes 15\Theme Colors\Orange Red.xml"
    Select Case i
        Case 0
            GetColorScheme = thmColor1
        Case 1
            GetColorScheme = thmColor2
    End Select
End Function

代码用于更改连续饼图的颜色主题，这些饼图在气泡图中用作气泡。所以该函数只是为了选择我之前保存为字符串的颜色方案，然后根据脚本的运行更改它，以便第一个饼具有另一个颜色而不是下一个饼图.... 我在调试

行的代码时收到错误消息

 ThisWorkbook.Theme.ThemeColorScheme.Load GetColorScheme(thmColor)

错误消息是运行时错误2147024809，表示指示的值超出范围。有人可以帮我解决这里出现的问题吗？

Answer 1

如果这是您自己创建的自定义主题（我没有安装2013，但2007或2010都没有Blue Green或Orange Red主题），我建议您的XML存在问题文件。

我相信您的thmColor变量将初始化为零，因为数字在VBA中，如果我将XML文件的路径替换为Microsoft的一个，那么您的代码可以正常工作。（虽然总是挑选thmColor1。）

此外，如果我损坏其中一个文件中的XML，我会收到错误“运行时错误”-2147024809（80070057）由于内容问题，无法打开该文件。由于您收到相同的错误超出范围值的数字我猜你的颜色错误定义了错误的十六进制值。

Answer 2

正如我在原始帖子的评论中提到的那样......

using VBA for a pie bubble chart in excel

此运行时错误的原因

有两个显而易见的事情可能导致此错误：

宏观＆amp;函数当前设置为仅使用两种颜色方案，因此如果您尝试第三次或更多次调用此函数，您将收到此错误。如果您传递的任何thmColor索引值不是0或1，则该函数将返回False而不是有效字符串。
在返回的字符串值不有效路径＆amp;的情况下，宏也会失败。用户计算机上已安装主题的文件名。仔细检查您是否为函数内的thmColor1和thmColor2变量提供了有效的文件路径。

原始答案已更新，允许在两种指定的配色方案之间进行旋转。请使用MOD语句中的Select Case函数：

Function GetColorScheme(i as Long) as String  '## Returns the path of a color scheme to load
    '## Currently set up to ROTATE between only two color schemes.
    '   You can add more, but you will also need to change the 
    '   Select Case i Mod 2, to i Mod n; where n = the number 
    '   of schemes you will rotate through.
    Const thmColor1 as String = "C:\Program Files (x86)\Microsoft Office\Document Themes 14\Theme Colors\Apex.xml"
    Const thmColor2 as String = "C:\Program Files (x86)\Microsoft Office\Document Themes 14\Theme Colors\Essential.xml"


    Select Case i Mod 2  '## i Mod n; where n = the number of Color Schemes.
        case 0
            GetColorScheme = thmColor1
        case 1
            GetColorScheme = thmColor2
        'Case n  '## You should have an additional case for each 1 to n.
        '
    End Select
End Function

对于其他颜色，您需要初始化表示其他主题文件的其他变量，并相应地修改Select Case块。

你可能会比这更复杂，但如果不确切知道你需要应用多少这些，我提供了一个可行的，可扩展的解决方案。如果您有很多图表并且想要遍历可用主题，那么也可以这样做。变化的复杂程度取决于您想要的变化程度，但您可以设想在主题文件夹中声明一个数组并捕获所有安装的主题，并按顺序迭代这些主题。

vba代码中的运行时错误

2 个答案: