1

以下代码旨在创建一个气泡饼图（饼图为气泡的气泡图）。它递归地将饼图复制到气泡图中。我的问题是，使用这种方法，最终的饼图看起来有点椭圆——不是真的圆。我怀疑的一个问题与某种格式有关。

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 Mod 2
        Case 0
            GetColorScheme = thmColor1
        Case 1
            GetColorScheme = thmColor2
    End Select
End Function

我发现如果双击特定的 ubble 选择格式数据点然后转到填充和拉伸选项（仅在选择图片填充时才可能），问题是可以解决的。问题是我的数据正在发生变化，我需要一种动态的方式将其实现到上述代码中。有没有办法做到这一点？

我在这里指的是这个控制台http://s1.directupload.net/file/d/3300/7dlimc3g_png.htm

4

1 回答 1

1

I think this might be the problem if your Pie chart is not a perfectly square shape. I can replicate your issue, and even when I check the Fill options, the offsets are all 0%. I can adjust them, but that is not a reliable way to do it. So, the best option I think will be to ensure that your pie chart .Parent is a square shape. To do this, before you CopyPicture, set its Height equal to its Width, like this:

chtMarker.Parent.Height = chtMarker.Parent.Width  '## Ensure the chartObject is a square, so it will not be distorted when pasted.
chtMarker.Parent.CopyPicture xlScreen, xlPicture
于 2013-06-28T14:01:55.460 回答