VBA создает две одинаковые круговые диаграммы на разных листах одной и той же книги - PullRequest
Новая
       15

VBA создает две одинаковые круговые диаграммы на разных листах одной и той же книги

0 голосов
/ 24 сентября 2018

Я хочу создать круговую диаграмму для сводной таблицы. Моя сводная таблица находится в той же книге на листе «New_Pivot». Я хочу создать круговую диаграмму в той же книге, но на другой лист с именем «Круговая диаграмма». У меня естьсоздал приведенный ниже код с форматированием размера и цвета фона. Мой код приведен ниже: 

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", а также мне нужно создатьдве одинаковые круговые диаграммы на этом рабочем листе "круговая диаграмма".Я новичок здесь, поэтому я не могу выполнить эту операцию, когда я хочу создать две одинаковые круговые диаграммы на листе "Круговая диаграмма".

...