图例格式化不会通过 VBA 发生
Legend Formatting not happening via VBA
有没有人愿意指出我的代码逻辑中的缺陷。没有抛出任何错误，但我没有得到想要的结果。
逻辑：宏会获取主图表所有图例的所有属性，将其存储在一个数组中，然后对整个ppt中的其他图表应用相同的格式数组。
代码：
Sub FormatLegendsOfCharts(
Dim NewSel As Selection
Set NewSel = ActiveWindow.Selection
On Error Resume Next
Dim ThisShape As Shape
Set ThisShape = ActiveWindow.Selection.ShapeRange(1)
On Error GoTo 0
If ThisShape Is Nothing Then GoTo 100:
If ThisShape.HasChart = True Then
Dim ThisChart As Chart
Set ThisChart = ThisShape.Chart
If ThisChart.ChartType = xlLineMarkers Or ThisChart.ChartType = xlLine Then
Dim GetSourceFormatting() As Variant
ReDim GetSourceFormatting(ThisChart.SeriesCollection.Count, 8)
Dim i As Long
For i = 1 To ThisChart.SeriesCollection.Count
Dim EachSeries As Series
Set EachSeries = ThisChart.SeriesCollection(i)
GetSourceFormatting((i - 1), 0) = EachSeries.Border.Color
GetSourceFormatting((i - 1), 1) = EachSeries.Border.Weight
GetSourceFormatting((i - 1), 2) = EachSeries.Format.Line.ForeColor.RGB
GetSourceFormatting((i - 1), 3) = EachSeries.Format.Line.Weight
GetSourceFormatting((i - 1), 4) = EachSeries.MarkerStyle
GetSourceFormatting((i - 1), 5) = EachSeries.MarkerSize
GetSourceFormatting((i - 1), 6) = EachSeries.MarkerBackgroundColor
GetSourceFormatting((i - 1), 7) = EachSeries.MarkerForegroundColor
GetSourceFormatting((i - 1), 8) = EachSeries.Name
Next
Call FormatLegendsInOtherCharts(GetSourceFormatting())
Else
MsgBox "Macro only works on line chart."
End If
Else
MsgBox "Please select master chart"
End If
MsgBox "Done"
Exit Sub
100:
MsgBox "Please select master chart"
End Sub
'-----------------------------------------------------------------
Private Sub FormatLegendsInOtherCharts(Database() As Variant)
Dim j As Long
Dim k As Long
For j = 1 To ActivePresentation.Slides.Count
Dim ThisSlide As Slide
Set ThisSlide = ActivePresentation.Slides(j)
For k = 1 To ThisSlide.Shapes.Count
Dim ThisOtherShape As Shape
Set ThisOtherShape = ThisSlide.Shapes(k)
If ThisOtherShape.HasChart = True Then
Dim ThisOtherChart As Chart
Set ThisOtherChart = ThisOtherShape.Chart
If ThisOtherChart.ChartType = xlLineMarkers Then
Call FormattingHappensHere(ThisOtherChart, Database())
End If
End If
Next
Next
End Sub
'--------------------------------------------------------------------
Private Sub FormattingHappensHere(OurChart As Chart, Databasee() As Variant)
Dim i As Long
Dim k As Long
For i = 1 To OurChart.SeriesCollection.Count
Dim EachOtherSeries As Series
Set EachOtherSeries = OurChart.SeriesCollection(i)
For k = 1 To UBound(Databasee())
If EachOtherSeries.Name = Databasee((k - 1), 8) Then
EachOtherSeries.Border.Color = Databasee((k - 1), 0)
EachOtherSeries.Border.Weight = Databasee((k - 1), 1)
EachOtherSeries.Format.Line.ForeColor.RGB = Databasee((k - 1), 2)
EachOtherSeries.Format.Line.Weight = Databasee((k - 1), 3)
EachOtherSeries.MarkerStyle = Databasee((k - 1), 4)
EachOtherSeries.MarkerSize = Databasee((k - 1), 5)
EachOtherSeries.MarkerBackgroundColor = Databasee((k - 1), 6)
EachOtherSeries.MarkerForegroundColor = Databasee((k - 1), 7)
End If
Next
Set EachOtherSeries = Nothing
Next
End Sub
您有：
If ThisOtherChart.ChartType = xlLineMarkers Then
Call FormattingHappensHere(ThisOtherChart, Database())
End If
但你的意思可能是：
If ThisOtherChart.ChartType = xlLine Or ThisOtherChart.ChartType = xlLineMarkers Then
编辑：这对我有用（为清楚起见进行了一些重构）
Option Explicit
Sub FormatLegendsOfCharts()
Dim MasterChart As Chart, pres As Presentation
Dim GetSourceFormatting() As Variant, i As Long
Set pres = ActivePresentation
Set MasterChart = SelectedChart()
If MasterChart Is Nothing Then Exit Sub
ReDim GetSourceFormatting(MasterChart.SeriesCollection.Count, 8)
For i = 1 To MasterChart.SeriesCollection.Count
With MasterChart.SeriesCollection(i)
GetSourceFormatting((i - 1), 0) = .Border.Color
GetSourceFormatting((i - 1), 1) = .Border.Weight
GetSourceFormatting((i - 1), 2) = .Format.Line.ForeColor.RGB
GetSourceFormatting((i - 1), 3) = .Format.Line.Weight
GetSourceFormatting((i - 1), 4) = .MarkerStyle
GetSourceFormatting((i - 1), 5) = .MarkerSize
GetSourceFormatting((i - 1), 6) = .MarkerBackgroundColor
GetSourceFormatting((i - 1), 7) = .MarkerForegroundColor
GetSourceFormatting((i - 1), 8) = .Name
End With
Next
FormatLegendsInOtherCharts pres, GetSourceFormatting
MsgBox "Done"
End Sub
'get the user-selected chart (or Nothing if no valid selection)
Private Function SelectedChart() As Chart
Dim ThisShape As Shape
Dim ThisChart As Chart
On Error Resume Next
Set ThisShape = ActiveWindow.Selection.ShapeRange(1)
On Error GoTo 0
If ThisShape Is Nothing Then
MsgBox "Please select a Line chart"
Exit Function
Else
If Not ThisShape.HasChart Then
MsgBox "Please select a Line chart"
Exit Function
Else
Set ThisChart = ThisShape.Chart
If Not OKChart(ThisChart) Then
MsgBox "Macro only works on line chart."
Exit Function
End If
End If
End If
Set SelectedChart = ThisChart
End Function
'check chart type
Private Function OKChart(cht As Chart)
OKChart = cht.ChartType = xlLine Or cht.ChartType = xlLineMarkers
End Function
Private Sub FormatLegendsInOtherCharts(pres As Presentation, Database() As Variant)
Dim j As Long, k As Long, ThisOtherChart As Chart
Dim ThisSlide As Slide, ThisOtherShape As Shape
For j = 1 To pres.Slides.Count
Set ThisSlide = pres.Slides(j)
For k = 1 To ThisSlide.Shapes.Count
Set ThisOtherShape = ThisSlide.Shapes(k)
If ThisOtherShape.HasChart = True Then
Set ThisOtherChart = ThisOtherShape.Chart
If OKChart(ThisOtherChart) Then
FormattingHappensHere ThisOtherChart, Database()
End If
End If
Next
Next
End Sub
Private Sub FormattingHappensHere(OurChart As Chart, Databasee() As Variant)
Dim i As Long, k As Long
For i = 1 To OurChart.SeriesCollection.Count
With OurChart.SeriesCollection(i)
For k = 1 To UBound(Databasee())
If .Name = Databasee((k - 1), 8) Then
.Border.Color = Databasee((k - 1), 0)
.Border.Weight = Databasee((k - 1), 1)
.Format.Line.ForeColor.RGB = Databasee((k - 1), 2)
.Format.Line.Weight = Databasee((k - 1), 3)
.MarkerStyle = Databasee((k - 1), 4)
.MarkerSize = Databasee((k - 1), 5)
.MarkerBackgroundColor = Databasee((k - 1), 6)
.MarkerForegroundColor = Databasee((k - 1), 7)
End If
Next
End With
Next
End Sub
有没有人愿意指出我的代码逻辑中的缺陷。没有抛出任何错误，但我没有得到想要的结果。
逻辑：宏会获取主图表所有图例的所有属性，将其存储在一个数组中，然后对整个ppt中的其他图表应用相同的格式数组。
代码：
Sub FormatLegendsOfCharts(
Dim NewSel As Selection
Set NewSel = ActiveWindow.Selection
On Error Resume Next
Dim ThisShape As Shape
Set ThisShape = ActiveWindow.Selection.ShapeRange(1)
On Error GoTo 0
If ThisShape Is Nothing Then GoTo 100:
If ThisShape.HasChart = True Then
Dim ThisChart As Chart
Set ThisChart = ThisShape.Chart
If ThisChart.ChartType = xlLineMarkers Or ThisChart.ChartType = xlLine Then
Dim GetSourceFormatting() As Variant
ReDim GetSourceFormatting(ThisChart.SeriesCollection.Count, 8)
Dim i As Long
For i = 1 To ThisChart.SeriesCollection.Count
Dim EachSeries As Series
Set EachSeries = ThisChart.SeriesCollection(i)
GetSourceFormatting((i - 1), 0) = EachSeries.Border.Color
GetSourceFormatting((i - 1), 1) = EachSeries.Border.Weight
GetSourceFormatting((i - 1), 2) = EachSeries.Format.Line.ForeColor.RGB
GetSourceFormatting((i - 1), 3) = EachSeries.Format.Line.Weight
GetSourceFormatting((i - 1), 4) = EachSeries.MarkerStyle
GetSourceFormatting((i - 1), 5) = EachSeries.MarkerSize
GetSourceFormatting((i - 1), 6) = EachSeries.MarkerBackgroundColor
GetSourceFormatting((i - 1), 7) = EachSeries.MarkerForegroundColor
GetSourceFormatting((i - 1), 8) = EachSeries.Name
Next
Call FormatLegendsInOtherCharts(GetSourceFormatting())
Else
MsgBox "Macro only works on line chart."
End If
Else
MsgBox "Please select master chart"
End If
MsgBox "Done"
Exit Sub
100:
MsgBox "Please select master chart"
End Sub
'-----------------------------------------------------------------
Private Sub FormatLegendsInOtherCharts(Database() As Variant)
Dim j As Long
Dim k As Long
For j = 1 To ActivePresentation.Slides.Count
Dim ThisSlide As Slide
Set ThisSlide = ActivePresentation.Slides(j)
For k = 1 To ThisSlide.Shapes.Count
Dim ThisOtherShape As Shape
Set ThisOtherShape = ThisSlide.Shapes(k)
If ThisOtherShape.HasChart = True Then
Dim ThisOtherChart As Chart
Set ThisOtherChart = ThisOtherShape.Chart
If ThisOtherChart.ChartType = xlLineMarkers Then
Call FormattingHappensHere(ThisOtherChart, Database())
End If
End If
Next
Next
End Sub
'--------------------------------------------------------------------
Private Sub FormattingHappensHere(OurChart As Chart, Databasee() As Variant)
Dim i As Long
Dim k As Long
For i = 1 To OurChart.SeriesCollection.Count
Dim EachOtherSeries As Series
Set EachOtherSeries = OurChart.SeriesCollection(i)
For k = 1 To UBound(Databasee())
If EachOtherSeries.Name = Databasee((k - 1), 8) Then
EachOtherSeries.Border.Color = Databasee((k - 1), 0)
EachOtherSeries.Border.Weight = Databasee((k - 1), 1)
EachOtherSeries.Format.Line.ForeColor.RGB = Databasee((k - 1), 2)
EachOtherSeries.Format.Line.Weight = Databasee((k - 1), 3)
EachOtherSeries.MarkerStyle = Databasee((k - 1), 4)
EachOtherSeries.MarkerSize = Databasee((k - 1), 5)
EachOtherSeries.MarkerBackgroundColor = Databasee((k - 1), 6)
EachOtherSeries.MarkerForegroundColor = Databasee((k - 1), 7)
End If
Next
Set EachOtherSeries = Nothing
Next
End Sub
您有：
If ThisOtherChart.ChartType = xlLineMarkers Then
Call FormattingHappensHere(ThisOtherChart, Database())
End If
但你的意思可能是：
If ThisOtherChart.ChartType = xlLine Or ThisOtherChart.ChartType = xlLineMarkers Then
编辑：这对我有用（为清楚起见进行了一些重构）
Option Explicit
Sub FormatLegendsOfCharts()
Dim MasterChart As Chart, pres As Presentation
Dim GetSourceFormatting() As Variant, i As Long
Set pres = ActivePresentation
Set MasterChart = SelectedChart()
If MasterChart Is Nothing Then Exit Sub
ReDim GetSourceFormatting(MasterChart.SeriesCollection.Count, 8)
For i = 1 To MasterChart.SeriesCollection.Count
With MasterChart.SeriesCollection(i)
GetSourceFormatting((i - 1), 0) = .Border.Color
GetSourceFormatting((i - 1), 1) = .Border.Weight
GetSourceFormatting((i - 1), 2) = .Format.Line.ForeColor.RGB
GetSourceFormatting((i - 1), 3) = .Format.Line.Weight
GetSourceFormatting((i - 1), 4) = .MarkerStyle
GetSourceFormatting((i - 1), 5) = .MarkerSize
GetSourceFormatting((i - 1), 6) = .MarkerBackgroundColor
GetSourceFormatting((i - 1), 7) = .MarkerForegroundColor
GetSourceFormatting((i - 1), 8) = .Name
End With
Next
FormatLegendsInOtherCharts pres, GetSourceFormatting
MsgBox "Done"
End Sub
'get the user-selected chart (or Nothing if no valid selection)
Private Function SelectedChart() As Chart
Dim ThisShape As Shape
Dim ThisChart As Chart
On Error Resume Next
Set ThisShape = ActiveWindow.Selection.ShapeRange(1)
On Error GoTo 0
If ThisShape Is Nothing Then
MsgBox "Please select a Line chart"
Exit Function
Else
If Not ThisShape.HasChart Then
MsgBox "Please select a Line chart"
Exit Function
Else
Set ThisChart = ThisShape.Chart
If Not OKChart(ThisChart) Then
MsgBox "Macro only works on line chart."
Exit Function
End If
End If
End If
Set SelectedChart = ThisChart
End Function
'check chart type
Private Function OKChart(cht As Chart)
OKChart = cht.ChartType = xlLine Or cht.ChartType = xlLineMarkers
End Function
Private Sub FormatLegendsInOtherCharts(pres As Presentation, Database() As Variant)
Dim j As Long, k As Long, ThisOtherChart As Chart
Dim ThisSlide As Slide, ThisOtherShape As Shape
For j = 1 To pres.Slides.Count
Set ThisSlide = pres.Slides(j)
For k = 1 To ThisSlide.Shapes.Count
Set ThisOtherShape = ThisSlide.Shapes(k)
If ThisOtherShape.HasChart = True Then
Set ThisOtherChart = ThisOtherShape.Chart
If OKChart(ThisOtherChart) Then
FormattingHappensHere ThisOtherChart, Database()
End If
End If
Next
Next
End Sub
Private Sub FormattingHappensHere(OurChart As Chart, Databasee() As Variant)
Dim i As Long, k As Long
For i = 1 To OurChart.SeriesCollection.Count
With OurChart.SeriesCollection(i)
For k = 1 To UBound(Databasee())
If .Name = Databasee((k - 1), 8) Then
.Border.Color = Databasee((k - 1), 0)
.Border.Weight = Databasee((k - 1), 1)
.Format.Line.ForeColor.RGB = Databasee((k - 1), 2)
.Format.Line.Weight = Databasee((k - 1), 3)
.MarkerStyle = Databasee((k - 1), 4)
.MarkerSize = Databasee((k - 1), 5)
.MarkerBackgroundColor = Databasee((k - 1), 6)
.MarkerForegroundColor = Databasee((k - 1), 7)
End If
Next
End With
Next
End Sub