2

我的代码是

    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 说指示的值超出范围..有人可以帮我这里出现的问题吗？

4

2 回答 2

2

正如我在原始线程的评论中提到的......

在 Excel 中使用 VBA 制作饼状气泡图

此运行时错误的原因

有两个明显的事情可能会导致此错误：

  • 宏 & 函数目前设置为仅使用两种配色方案，因此如果您尝试第三次或更多次调用此函数，则会收到此错误。如果您传递任何thmColor不是0or的索引值1，该函数将返回False而不是有效字符串。
  • 如果返回的字符串值不是用户机器上已安装主题的有效路径和文件名，宏也会失败。仔细检查您是否为函数内的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块。

您可能会比这更复杂，但在不知道您需要应用其中多少的情况下，我提供了一个可行的、可扩展的解决方案。如果您有很多图表并且想要循环访问可用的主题，也可以这样做。更改的复杂程度取决于您想要多少差异，但您可以想象声明一个数组并在主题文件夹中捕获所有已安装的主题，然后按顺序迭代这些主题。

于 2013-06-28T02:58:42.550 回答
1

如果这是您自己创建的自定义主题（我没有安装 2013，但 2007 或 2010 都没有蓝绿色或橙红色主题），我建议您的 XML 文件有问题。

我相信您的thmColor变量将被初始化为零，因为数字在 VBA 中，如果我将您的 XML 文件的路径替换为 Microsoft 的路径之一，您的代码对我来说很好。（尽管总是选择thmColor1。）

此外，如果我损坏其中一个文件中的 XML，我会收到错误“运行时错误'-2147024809 (80070057) 由于内容问题而无法打开文件'。因为​​您得到的错误号与超出范围值我猜你用错误的十六进制值错误地定义了颜色。

于 2013-06-27T23:18:22.090 回答