在Excel中使用VBA绘制饼图 [英] using VBA for a pie bubble chart in excel

问题描述

我的代码是

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 14\Theme Colors\Blue Green.xml"
Const thmColor2 As String = "C:\Program Files\Microsoft Office\Document Themes 14\Theme Colors\Orange Red.xml"
    Select Case i
        Case 0
            GetColorScheme = thmColor1
        Case 1
            GetColorScheme = thmColor2
    End Select
End Function

该代码用于更改连续饼图的颜色主题，这些饼图在气泡图中用作气泡.因此，该函数只是要选择我之前保存为字符串的配色方案，然后根据脚本的运行情况对其进行更改，以使第一个饼图比下一个饼图具有另一种颜色..在行上调试代码时出现错误消息

the code is meant to change the colour theme of successive pie charts which are used as bubbles in a bubble chart. So The function is just meant to select a colour scheme which I previously saved as a string and then to change it according to the run of the script so that the first pie has another colour than the next pie chart .... I do get an error message when debugging the code at the line

ThisWorkbook.Theme.ThemeColorScheme.Load GetColorScheme(thmColor)

ThisWorkbook.Theme.ThemeColorScheme.Load GetColorScheme(thmColor)

错误消息是运行时错误2147024809，指示指示的值超出范围.任何人都可以帮我解决这里出现的问题吗?

the error message is runtime error 2147024809 saying the indicated value is out of range..can anybody help me what appears to be the problem here?

有没有办法整合饼状图的显示方式(每个饼图的列标题中都标有组件的名称，然后将其转移到气泡图中?

And would there be any way to integrate the display of the pie components (the name of the componetns which si indicated in the head of the column in each pie chart which is then transferred to the bubble chart?

推荐答案

最简单的方法是在复制每个图表之前仅更改主题颜色.

The simplest route will be to just change the theme colors before you copy each chart.

已录制的宏将为您提供类似的信息(对于Windows 7上的Excel 2010)，我只选择了两个，但您可以使用任意数量，也可以创建自己的自定义主题来使用:

Recorded macro will give you something like this (for Excel 2010 on Windows 7), I choose just two, but you could use any number of them, or you could create your own custom themes to use, too:

ActiveWorkbook.Theme.ThemeColorScheme.Load ( _
    "C:\Program Files (x86)\Microsoft Office\Document Themes 14\Theme Colors\Apex.xml" _
    )
ActiveWorkbook.Theme.ThemeColorScheme.Load ( _
    "C:\Program Files (x86)\Microsoft Office\Document Themes 14\Theme Colors\Essential.xml" _
    )

要复制这些颜色，请打开宏录制器，然后从功能区中选择一些配色方案(页面布局" |颜色").我认为这应该适用于Excel 2007+，尽管2007年的文件路径将与示例中的文件路径不同.

To replicate these, turn on your macro recorder, and then select a few color schemes from the Ribbon (Page Layout | Colors). I think this should work for Excel 2007+, although the file path will be different for 2007 than it is in my example.

现在，如何将其应用于您的代码...有几种方法可以做到这一点.我将添加几个Const字符串变量，存储我们将使用的每个变量的路径.然后，我将添加一个索引变量和一个函数，该函数将根据索引确定要使用的主题.

Now, how to apply this to your code... THere are several ways to do this. I will add several Const string variables, storing the path of each them we will use. Then I will add an index variable and a function which will determine what theme to use based on the index.

您将需要在函数中添加其他Case角色，以容纳不止两个颜色主题，否则会出错.

You will need to add additional Case stements in the function to accommodate more than just two color themes, otherwise it will error.

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) '## Call a function to get the color scheme location
    chtMarker.Parent.CopyPicture xlScreen, xlPicture
    lngPointIndex = lngPointIndex + 1
    chtMain.SeriesCollection(1).Points(lngPointIndex).Paste
    thmColor = thmColor + 1  '## Increment our index variable
Next

lngPointIndex = 0

Application.ScreenUpdating = True
End Sub

包括附加功能GetColorScheme.在此功能中，添加Const字符串变量(例如thmColor1和thmColor2)，并将其值分配给在选择颜色主题"时从宏记录器生成的文件路径.在此示例中，我仅使用两个，但是您可以使用许多，只要在Select块中添加相应的Case.

Include an additional function, GetColorScheme. In this function, add Const string variables like thmColor1 and thmColor2, and assign their values to the file paths which you generate from the macro recorder when selecting a Color Theme. In this example, I only use two, but you could use many of them, as long as you add a corresponding Case in the Select block.

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

这篇关于在Excel中使用VBA绘制饼图的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！