VBA在同一工作簿的不同工作表上创建两个相同的饼图

时间:2018-09-24 08:10:50

标签: excel vba excel-vba pivot-table excel-charts

我要为数据透视表创建饼图。我的数据透视表位于工作表“ New_Pivot”中的同一工作簿中。我想在同一工作簿中创建饼图,但工作表名为“ Pie_chart”。我有创建了下面给出的格式化大小和背景颜色的代码。我的代码如下:

Sub Formattedchart()
'
' Formattedchart Macro
'

'
    Sheets("New_pivot").Select
    Range("A1:B16").Select

    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.ChartType = xlPie

    ActiveChart.ShowValueFieldButtons = False

    Dim cht1 As Shape
    Set cht1 = ActiveSheet.Shapes(1)
    cht1.Name = "chart001"
    ActiveSheet.ChartObjects("chart001").Activate
    ActiveChart.SeriesCollection(1).Select
    ActiveChart.SeriesCollection(1).ApplyDataLabels




    ActiveSheet.ChartObjects("chart001").Activate
    ActiveSheet.Shapes("chart001").IncrementLeft -18
    ActiveSheet.Shapes("chart001").IncrementTop -125.25
    ActiveSheet.ChartObjects("chart001").Activate
    ActiveSheet.Shapes("chart001").ScaleWidth 0.9375, msoFalse, msoScaleFromTopLeft
    ActiveSheet.ChartObjects("chart001").Activate
    ActiveSheet.Shapes("chart001").ScaleHeight 1.73090296, msoFalse, _
        msoScaleFromTopLeft
    ActiveSheet.ChartObjects("chart001").Activate
    ActiveSheet.Shapes("chart001").ScaleHeight 1.1644936737, msoFalse, _
        msoScaleFromTopLeft
    ActiveSheet.ChartObjects("chart001").Activate
    ActiveSheet.Shapes("chart001").ScaleWidth 1.1377777778, msoFalse, _
        msoScaleFromTopLeft
    ActiveSheet.ChartObjects("chart001").Activate
    With ActiveSheet.Shapes("chart001").ThreeD
        .BevelTopType = msoBevelCircle
        .BevelTopInset = 6
        .BevelTopDepth = 6
    End With
    ActiveSheet.ChartObjects("chart001").Activate
    With ActiveSheet.Shapes("chart001").Fill
        .Visible = msoTrue
        .ForeColor.ObjectThemeColor = msoThemeColorAccent6
        .ForeColor.TintAndShade = 0
        .ForeColor.Brightness = 0.6000000238
        .Solid
    End With
    With ActiveSheet.Shapes("chart001").Fill
        .Visible = msoTrue
        .ForeColor.ObjectThemeColor = msoThemeColorAccent6
        .ForeColor.TintAndShade = 0
        .ForeColor.Brightness = 0.6000000238
        .Transparency = 0
        .Solid
    End With
    ActiveSheet.ChartObjects("chart001").Activate
    ActiveChart.SeriesCollection(1).Select
    ActiveChart.SeriesCollection(1).ChartType = xl3DPie
    ActiveChart.SeriesCollection(1).Select
    ActiveChart.SeriesCollection(1).ApplyDataLabels
    ActiveChart.ChartTitle.Select
    ActiveChart.ChartTitle.Text = "Consolidated"
    Selection.Format.TextFrame2.TextRange.Characters.Text = "Consolidated"
    With Selection.Format.TextFrame2.TextRange.Characters(1, 12).ParagraphFormat
        .TextDirection = msoTextDirectionLeftToRight
        .Alignment = msoAlignCenter
    End With
    With Selection.Format.TextFrame2.TextRange.Characters(1, 12).Font
        .BaselineOffset = 0
        .Bold = msoTrue
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.RGB = RGB(0, 0, 0)
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 18
        .Italic = msoFalse
        .Kerning = 12
        .Name = "+mn-lt"
        .UnderlineStyle = msoNoUnderline
        .Strike = msoNoStrike
    End With

    ActiveSheet.ChartObjects("chart001").Activate
    ActiveChart.ChartTitle.Select
    Selection.Caption = "=New_pivot!R1C2"
End Sub 

不幸的是,我无法在工作表“ Pie_chart”中创建相同的图表,并且我还需要在此工作表“ Pie-Chart”上创建两个相同的饼图。我是新来的,因此我无法在“ Pie_chart”工作表上创建两个相同的饼图的情况下执行此操作。

0 个答案:

没有答案