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

Question

我写了一个宏来动态填充圆环图。我需要甜甜圈外面的数据标签。我能够实现这一点的唯一方法是将数据分配给类型为 xlPie 的图表和另一个宏运行。之后设置 .ChartGroups(1).DoughnutHoleSize 似乎是一种解决方法，可以将图表外观更改为甜甜圈，同时保持数据标签就位。如果我将图表类型设置为 xlDoughnut，数据标签将再次改变位置。

我的问题是，当我将生成的图表复制并粘贴到另一个 sheet 时，副本恢复为 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

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

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

Chart type related problems when setting up chart type xlDoughnut

excel

vba

excel-charts