excel - 设置图表类型 xlDoughnut 时的图表类型相关问题

Question

我编写了一个宏来动态填充圆环图。我需要甜甜圈之外的数据标签。我能够实现这一点的唯一方法是将数据分配给类型的图表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, 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
        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

标签： excelvbaexcel-charts

Answer 1

最好再插入一个正方形。

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, 255)
            .TextFrame2.TextRange = "Test"
            With .TextFrame2.TextRange.Font
                .Bold = msoCTrue
                .Size = 18
                With .Fill
                    .Visible = msoTrue
                    .ForeColor.RGB = RGB(0, 0, 0)
                End With
            End With
            .TextFrame.AutoSize = True
        End With
    End With
End Sub