Would anyone be kind enough to highlight the flaw in the logic of my code. No errors are thrown but I am not getting the desired result.
Logic: The macro will get all properties of all legends of master chart, store it in an array and then apply the same formatting for other charts in the whole ppt from the array.
Code:
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
You have:
If ThisOtherChart.ChartType = xlLineMarkers Then
Call FormattingHappensHere(ThisOtherChart, Database())
End If
but you probably meant:
If ThisOtherChart.ChartType = xlLine Or ThisOtherChart.ChartType = xlLineMarkers Then
EDIT: this worked for me (some refactoring for clarity)
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