问题描述
我写了一个宏来动态填充甜甜圈图。我需要甜甜圈之外的数据标签。我能够实现此目标的唯一方法是将数据分配给类型为xlPie的图表并运行另一个宏。之后设置.ChartGroups(1).DoughnutHoleSize似乎是一种解决方法，可以将图表外观更改为甜甜圈，同时保留数据标签的位置。如果将图表类型设置为xlDoughnut，则数据标签将再次更改位置。
我的问题是，当我将生成的图表复制并粘贴到另一张纸上时，副本将还原为xlPie图表，即没有甜甜圈孔。因此，我尝试在饼图上添加一个圆形以使其成为甜甜圈。这种情况下的问题是图表的标题隐藏在圆形下方。
文件的其他用户必须定期将图表从生成位置复制并粘贴到另一个文件中，我希望粘贴的图表看起来像带有可见标题的甜甜圈。我怎样才能达到我想要的？以下是两个子项目，分别展示了每种情况。我的想法是：
在createChart_fakeDoughnut1()中，当手动复制并粘贴图表时保留格式，或者
createChart_fakeDoughnut2()中
我不知道如何实现这两个目标。解释为什么fakeDoughnut1粘贴时会更改其格式。
Sub createChart_fakeDoughnut1()
If ActiveSheet.ChartObjects.Count > 0 Then ActiveSheet.ChartObjects.Delete
Dim chrt As ChartObject
Dim dataRng As Range
Dim lft As Integer
lft = ActiveSheet.Range("D2").Left
Dim wdth As Integer
wdth = 500
Dim hgt As Integer
hgt = 300
Dim tp As Integer
tp = ActiveSheet.Range("D2").Top
Set chrt = ActiveSheet.ChartObjects.Add(Left:=lft,Width:=wdth,Height:=hgt,Top:=tp)
Dim i As Integer
For i = 1 To 10
ActiveSheet.Cells(i,1).Value = "A" & i
With ActiveSheet.Cells(i,2)
.Value = i / 55
.NumberFormat = "0.00%"
End With
Next i
Set dataRng = Range("A1:B10")
With chrt.Chart
.ChartType = xlPie
.SetSourceData Source:=dataRng
.HasTitle = True
.ChartTitle.IncludeInLayout = False
With .ChartTitle
.Text = "Test"
.Top = hgt / 2 - 20
.Left = wdth / 2 - 20
End With
.HasLegend = False
' set hole size here
.ChartGroups(1).DoughnutHoleSize = 50
End With
End Sub
Sub createChart_fakeDoughnut2()
If ActiveSheet.ChartObjects.Count > 0 Then ActiveSheet.ChartObjects.Delete
Dim chrt As ChartObject
Dim dataRng As Range
Dim lft As Integer
lft = ActiveSheet.Range("D2").Left
Dim wdth As Integer
wdth = 500
Dim hgt As Integer
hgt = 300
Dim tp As Integer
tp = ActiveSheet.Range("D2").Top
Set chrt = ActiveSheet.ChartObjects.Add(Left:=lft,2)
.Value = i / 55
.NumberFormat = "0.00%"
End With
Next i
Set dataRng = Range("A1:B10")
With chrt.Chart
.ChartType = xlPie
.SetSourceData Source:=dataRng
.HasTitle = True
With .ChartTitle
.Text = "Test"
.Top = hgt / 2 - 20
.Left = wdth / 2 - 20
End With
.HasLegend = False
' add circle form here
Dim x As Double,y As Double,h As Double,cd As Double
With .PlotArea
x = .Left
y = .Top
h = .Height
End With
cd = 120
Dim circ As Shape
Set circ = .Shapes.AddShape(msoShapeoval,x + h / 2 - cd / 2,_
y + h / 2 - cd / 2,cd,cd)
With circ
.Line.Visible = msoFalse
.Fill.ForeColor.RGB = RGB(255,255,255)
End With
End With
End Sub
解决方法
最好再插入一个正方形。
Sub createChart_fakeDoughnut2()
If ActiveSheet.ChartObjects.Count > 0 Then ActiveSheet.ChartObjects.Delete
Dim chrt As ChartObject
Dim dataRng As Range
Dim lft As Integer
lft = ActiveSheet.Range("D2").Left
Dim wdth As Integer
wdth = 500
Dim hgt As Integer
hgt = 300
Dim tp As Integer
tp = ActiveSheet.Range("D2").Top
Set chrt = ActiveSheet.ChartObjects.Add(Left:=lft,Width:=wdth,Height:=hgt,Top:=tp)
Dim i As Integer
For i = 1 To 10
ActiveSheet.Cells(i,1).Value = "A" & i
With ActiveSheet.Cells(i,2)
.Value = i / 55
.NumberFormat = "0.00%"
End With
Next i
Set dataRng = Range("A1:B10")
With chrt.Chart
.ChartType = xlPie
.SetSourceData Source:=dataRng
' .HasTitle = True
' With .ChartTitle
' .Text = "Test"
' .Top = hgt / 2 - 20
' .Left = wdth / 2 - 20
' End With
.HasLegend = False
' add circle form here
Dim x As Double,y As Double,h As Double,cd As Double,w As Double
With .PlotArea
x = .Left
y = .Top
h = .Height
w = .Width
End With
cd = 120
Dim circ As Shape
Set circ = .Shapes.AddShape(msoShapeOval,x + h / 2 - cd / 2,_
y + h / 2 - cd / 2,cd,cd)
With circ
.Line.Visible = msoFalse
.Fill.ForeColor.RGB = RGB(255,255,255)
End With
Dim Rect As Shape
Set Rect = .Shapes.AddShape(msoShapeRectangle,x + w / 2 - 20,y + h / 2 - 10,40,20)
With Rect
.Line.Visible = msoFalse
.Fill.ForeColor.RGB = RGB(255,255)
.TextFrame2.TextRange = "Test"
With .TextFrame2.TextRange.Font
.Bold = msoCTrue
.Size = 18
With .Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(0,0)
End With
End With
.TextFrame.AutoSize = True
End With
End With
End Sub