Измените порядок ввода серии или легенды в разных группах ChartGroup.

Question

Office 365

У меня есть комбинационная диаграмма в powerpoint. Одна серия имеет тип столбца, а остальные три являются строками. Все они находятся в основной оси Y. Ось X относится к типу категории (текстовые метки)

Вот пример того, как Powerpoint структурирует диаграмму

ChartGroup | Chart Type | PlotOrder | Legend | Correct Order 
1          |    Column  |  1        |    B   |       2
2          |    Line    |  1        |    A   |       1
2          |    Line    |  2        |    C   |       3
2          |    Line    |  3        |    D   |       4

В настоящее время легенда отображается так:

B A C D

Мне нужно, чтобы легенда отображалась как

A B C D

Это означает, что легенда A будет отображаться перед B, даже если она находится в другой группе графиков с более высоким индексом, чем у группы B. *

Я добавляю снимки данных и наглядные примеры того, что происходит: вот фиктивные данные, которые я использую:

Это это начальный порядок рядов, когда все они одного типа и в одной и той же группе диаграмм, порядок легенды серии соответствует требуемому.

Но затем, когда я меняю тип значения серии 1 со строки на столбец, происходит следующее: создается новая группа диаграмм, а значение серии 1 помещается в начало:

Даже порядок диаграмм в окне источника данных как было в начале:

И формула для значения Series1 по-прежнему выставляет свой порядок как 2: =SERIES(Sheet1!$B$1,Sheet1!$A$1:$A$17,Sheet1!$B$2:$B$17,**2**)

Возможно ли перемещение Легенда гола Series1 со второй позиции на первую, когда она находится в разных ChartGroups?

Я думаю о некоторых идеях:

1. добавление фиктивной серии в линейных диаграммах ChartGroup для отображения легенды Series1 Value во второй позиции и просто удалите легенду из столбца Диаграмма
2. Можно ли добавить заливку ниже линейных диаграмм, чтобы она выглядела как столбчатая диаграмма?

Любые предложения приветствуются,

Спасибо,

Answer 1

Я узнал вашу проблему. Поскольку диаграммы сгруппированы, отображение легенды изменяется, поэтому маловероятно, что диаграмма и легенда будут связаны.

Поэтому я решил использовать ярлыки. Я создал две макрокарты с правильной легендой и измененной диаграммой и скопировал только часть легенды на первом графике, а также добавил макрос для вставки в виде рисунка в часть легенды на втором графике. В разрешении есть недостаток.

Рабочий процесс

Изображение результата

код

Sub ModifyCahrtLegend()
    Dim Cht1 As Chart, Cht2 As Chart, Cht3 As Chart
    Dim Shp As Shape, Shp1 As Shape, Shp2 As Shape, Shp3 As Shape
    Dim Ws As Worksheet
    Dim rngX As Range
    Dim rngHeader As Range
    Dim Srs As Series
    Dim fn As String
    Dim obj As ChartObject
    Dim l, t, w, h
    Dim cl, tb, ct
    Dim i As Integer
    Dim a As Variant

    Set Ws = ActiveSheet

    For Each obj In Ws.ChartObjects
        obj.Delete
    Next obj
    With Ws
        Set rngX = .Range("a2", .Range("a" & Rows.Count).End(xlUp))
        Set rngHeader = .Range("b1")
    End With

    a = Array(1, 0, 2, 3)
    r = rngX.Rows.Count

    Set Shp1 = Ws.Shapes.AddChart(, Range("g1").Left, 100, 500, 300)
    Set Cht1 = Shp1.Chart

    With Cht1
        For Each Srs In .SeriesCollection
            Srs.Delete
        Next Srs
        .ChartType = xlLine
        .HasLegend = True
        .Legend.Position = xlLegendPositionBottom
        For i = 0 To 3
            Set Srs = .SeriesCollection.NewSeries
            With Srs
                .XValues = rngX
                .Values = rngHeader.Offset(0, a(i)).Offset(1).Resize(r)
                .Name = rngHeader.Offset(0, a(i))
            End With
        Next i
    End With
    Set Shp2 = Ws.Shapes.AddChart(, Range("g1").Left, 100, 500, 300)
    Set Cht2 = Shp2.Chart


    With Cht2
        For Each Srs In .SeriesCollection
            Srs.Delete
        Next Srs
        .ChartType = xlLine
        .HasLegend = True
        .Legend.Position = xlLegendPositionBottom
        For i = 0 To 3
            Set Srs = .SeriesCollection.NewSeries
            With Srs
                .XValues = rngX
                .Values = rngHeader.Offset(0, a(i)).Offset(1).Resize(r)
                .Name = rngHeader.Offset(0, a(i))
            End With
        Next i
        Set Srs = .SeriesCollection(2)
        With Srs
            .ChartType = xlColumnClustered
        End With
    End With

    With Cht1
        t = .Legend.Top
        l = .Legend.Left
        h = .Legend.Height
        w = .Legend.Width
        ' .CopyPicture
    End With

    '** picture editing
    Cht1.CopyPicture

    Range("C23").Select
    Ws.Pictures.Paste
    n = Ws.Shapes.Count
    Set Shp = Ws.Shapes(n)

    With Shp1
        cl = (.Width - w) / 2
        cb = .Height - t - h
        ct = .Height - h - cb
    End With

    With Shp
        .PictureFormat.CropLeft = cl
        .PictureFormat.CropRight = cl
        .PictureFormat.CropTop = ct
        .PictureFormat.CropBottom = cb
    End With

    Set Cht3 = Ws.Shapes.AddChart.Chart
     Set obj = Cht3.Parent
    With obj
        .Top = t
        .Left = l
        .Height = h
        .Width = w
        .ShapeRange.Line.ForeColor.RGB = RGB(255, 255, 255)
    End With

    Shp.CopyPicture
    Cht3.Paste
    fn = "legend.png"
    Cht3.Export fn, "PNG"

    Shp.Delete
    obj.Delete
    Shp1.Delete
    Set Shp = Cht2.Shapes.AddPicture(fn, msoFalse, msoCTrue, l, t, w, h)
    Kill fn

End Sub

Однако созданная таким образом диаграмма деформируется при изменении размера, поэтому было бы лучше создать диаграмму, задав ширину и высоту.

код 2

Sub testChart()

    ModifyLegend 500, 200 '<~~ set width, Height

End Sub
Sub ModifyLegend(myW, myH)
    Dim Cht1 As Chart, Cht2 As Chart, Cht3 As Chart
    Dim Shp As Shape, Shp1 As Shape, Shp2 As Shape, Shp3 As Shape
    Dim Ws As Worksheet
    Dim rngX As Range
    Dim rngHeader As Range
    Dim Srs As Series
    Dim fn As String
    Dim obj As ChartObject
    Dim l, t, w, h
    Dim cl, tb, ct
    Dim i As Integer
    Dim a As Variant

    Set Ws = ActiveSheet

    For Each obj In Ws.ChartObjects
        obj.Delete
    Next obj
    With Ws
        Set rngX = .Range("a2", .Range("a" & Rows.Count).End(xlUp))
        Set rngHeader = .Range("b1")
    End With

    a = Array(1, 0, 2, 3)
    r = rngX.Rows.Count

    Set Shp1 = Ws.Shapes.AddChart(, Range("g1").Left, 100, myW, myH)
    Set Cht1 = Shp1.Chart

    With Cht1
        For Each Srs In .SeriesCollection
            Srs.Delete
        Next Srs
        .ChartType = xlLine
        .HasLegend = True
        .Legend.Position = xlLegendPositionBottom
        For i = 0 To 3
            Set Srs = .SeriesCollection.NewSeries
            With Srs
                .XValues = rngX
                .Values = rngHeader.Offset(0, a(i)).Offset(1).Resize(r)
                .Name = rngHeader.Offset(0, a(i))
            End With
        Next i
    End With
    Set Shp2 = Ws.Shapes.AddChart(, Range("g1").Left, 100, myW, myH)
    Set Cht2 = Shp2.Chart


    With Cht2
        For Each Srs In .SeriesCollection
            Srs.Delete
        Next Srs
        .ChartType = xlLine
        .HasLegend = True
        .Legend.Position = xlLegendPositionBottom
        For i = 0 To 3
            Set Srs = .SeriesCollection.NewSeries
            With Srs
                .XValues = rngX
                .Values = rngHeader.Offset(0, a(i)).Offset(1).Resize(r)
                .Name = rngHeader.Offset(0, a(i))
            End With
        Next i
        Set Srs = .SeriesCollection(2)
        With Srs
            .ChartType = xlColumnClustered
        End With
    End With

    With Cht1
        t = .Legend.Top
        l = .Legend.Left
        h = .Legend.Height
        w = .Legend.Width
        ' .CopyPicture
    End With

    '** picture editing
    Cht1.CopyPicture

    Range("C23").Select
    Ws.Pictures.Paste
    n = Ws.Shapes.Count
    Set Shp = Ws.Shapes(n)

    With Shp1
        cl = (.Width - w) / 2
        cb = .Height - t - h
        ct = .Height - h - cb
    End With

    With Shp
        .PictureFormat.CropLeft = cl
        .PictureFormat.CropRight = cl
        .PictureFormat.CropTop = ct
        .PictureFormat.CropBottom = cb
    End With

    Set Cht3 = Ws.Shapes.AddChart.Chart
     Set obj = Cht3.Parent
    With obj
        .Top = t
        .Left = l
        .Height = h
        .Width = w
        .ShapeRange.Line.ForeColor.RGB = RGB(255, 255, 255)
    End With

    Shp.CopyPicture
    Cht3.Paste
    fn = "legend.png"
    Cht3.Export fn, "PNG"

    Shp.Delete
    obj.Delete
    Shp1.Delete
    Set Shp = Cht2.Shapes.AddPicture(fn, msoFalse, msoCTrue, l, t, w, h)
    Kill fn

End Sub