vba - vba 代码中的运行时错误

标签 vba runtime

我的代码是

    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,指出指示的值超出范围。任何人都可以帮助我解决这里出现的问题吗?

最佳答案

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

using VBA for a pie bubble chart in excel

此运行时错误的原因

有两个明显的原因可能会导致此错误:

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

原始答案已更新,以允许在两个指定的配色方案之间旋转。在 Select Case 语句中使用 MOD 函数,因此:

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 block 。

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

关于vba - vba 代码中的运行时错误,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/17354071/

相关文章:

web-services - Delphi Web 服务如何工作? (在运行时添加方法??)

python - 语法错误和运行时错误有什么区别?

excel - 为什么没有应用我的 VBE 颜色主题?

vba - 为什么 Excel VBA 中的 .Find() 方法似乎只检查前 15 个字符?

python - ctypes.Structure 在运行时修改_fields_

java - 主线程被挂起并且运行时异常

regex - VBA正则表达式单词后的所有内容

excel - 从 Excel 与 VBA 调用时,VBA UDF 给出不同的答案

excel - 舍入值未正确插入 Excel

python - 未检测到 ANTLR3 python 运行时