更改不同图表组中的系列绘图顺序或图例输入顺序
Change Series plotorder or legend entry order across different ChartGroups
Office 365
我在 powerpoint 中有一个组合图表。一个系列是柱式的，另外三个是线式的。它们都在主 Y 轴上。 X-axis属于类别类型（文本标签）
这是一个关于 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 的图表组的另一个图表组中。
我正在添加数据快照和正在发生的事情的可视化示例：
这是我正在使用的虚拟数据：
这是系列的初始顺序，当所有系列都是同一类型并且在同一个ChartGroup中时，系列图例的顺序按要求排列。
但是当我将系列 1 值类型从线更改为列时，会发生这种情况，创建了一个新图表组，并将系列 1 值放在开头：
甚至数据源中的图表顺序Window也和开始时一样：
并且 Series1 值的公式仍将其顺序设置为 2：
=SERIES(Sheet1!$B,Sheet1!$A:$A,Sheet1!$B:$B,**2**)
Series1 Goal Legend 在不同的 ChartGroups 中时，是否可以将其从第二个位置移动到第一个位置？
我在想一些点子：
- 在折线图 ChartGroup 中添加一个虚拟系列以在第二个位置显示 Series1 值图例，并从柱形图中删除图例
- 是否可以在折线图下方添加填充，使其看起来像柱形图？
欢迎提出任何建议，
谢谢，
我认识到你的问题。由于图表被分组，图例的显示发生变化，所以图表和图例不太可能有联系。
所以我决定使用快捷方式。我用正确的图例和修改后的图表制作了两个宏图表，只复制了第一个图表的图例部分，并制作了一个宏作为图片粘贴到第二个图表的图例部分。分辨率有问题。
工作流程
结果图片
代码
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
Office 365
我在 powerpoint 中有一个组合图表。一个系列是柱式的，另外三个是线式的。它们都在主 Y 轴上。 X-axis属于类别类型（文本标签）
这是一个关于 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 的图表组的另一个图表组中。
我正在添加数据快照和正在发生的事情的可视化示例： 这是我正在使用的虚拟数据：
这是系列的初始顺序，当所有系列都是同一类型并且在同一个ChartGroup中时，系列图例的顺序按要求排列。
但是当我将系列 1 值类型从线更改为列时，会发生这种情况，创建了一个新图表组，并将系列 1 值放在开头：
甚至数据源中的图表顺序Window也和开始时一样：
并且 Series1 值的公式仍将其顺序设置为 2：
=SERIES(Sheet1!$B,Sheet1!$A:$A,Sheet1!$B:$B,**2**)
Series1 Goal Legend 在不同的 ChartGroups 中时，是否可以将其从第二个位置移动到第一个位置？
我在想一些点子：
- 在折线图 ChartGroup 中添加一个虚拟系列以在第二个位置显示 Series1 值图例，并从柱形图中删除图例
- 是否可以在折线图下方添加填充，使其看起来像柱形图？
欢迎提出任何建议，
谢谢，
我认识到你的问题。由于图表被分组，图例的显示发生变化，所以图表和图例不太可能有联系。
所以我决定使用快捷方式。我用正确的图例和修改后的图表制作了两个宏图表，只复制了第一个图表的图例部分，并制作了一个宏作为图片粘贴到第二个图表的图例部分。分辨率有问题。
工作流程
结果图片
代码
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