I have a 150-slide powerpoint presentation that I want to revise due to a company rebranding effort. Our previous turquoise color has been used on text, lines, shapes and shape fills. I would like to build a VBA script that runs across the entire presentation, and in one fell swoop amends all slides and replaces this bluish color with our new dark gray color.
The old corporate color was RGB(0, 176, 240) - turquoise
The new corporate color is RGB(71, 67, 65) - dark gray
I have tried a multitude of different vba's across the internet but can't get it to work properly. Here is a screenshot of a typical slide from the old color - all the blue items should be changed to dark gray:
This piece of VBA code from a helpful forum member worked really well for shape fills - if this could be re-worked to include any text and shape outlines and lines as well, it would be perfect.
Sub ChangeShapeColor()
Dim oSh As Shape
Dim oSl As Slide
' Look at each slide in the current presentation:
For Each oSl In ActivePresentation.Slides
' Look at each shape on each slide:
For Each oSh In oSl.Shapes
' IF the shape's .Fill.ForeColor.RGB = turqoise color:
If oSh.Fill.ForeColor.RGB = RGB(0, 176, 240) Then
' Change it to corporate dark grey:
oSh.Fill.ForeColor.RGB = RGB(71, 67, 65)
End If
Next oSh
Next oSl
End Sub
Thanks in advance,
This should get you a step closer, though I'd probably rewrite it as a function that you could pass lFindColor and lReplaceColor to.
Sub ReplaceColors()
Dim lFindColor As Long
Dim lReplaceColor As Long
Dim oSl As Slide
Dim oSh As Shape
Dim x As Long
lFindColor = RGB(255, 128, 128)
lReplaceColor = RGB(128, 128, 255)
For Each oSl In ActivePresentation.Slides
For Each oSh In oSl.Shapes
With oSh
' Fill
If .Fill.ForeColor.RGB = lFindColor Then
.Fill.ForeColor.RGB = lReplaceColor
End If
' Line
If .Line.Visible Then
If .Line.ForeColor.RGB = lFindColor Then
.Line.ForeColor.RGB = lReplaceColor
End If
End If
' Text
If .HasTextFrame Then
If .TextFrame.HasText Then
For x = 1 To .TextFrame.TextRange.Runs.Count
If .TextFrame.TextRange.Runs(x).Font.Color.RGB = lFindColor Then
.TextFrame.TextRange.Runs(x).Font.Color.RGB = lReplaceColor
End If
Next
End If
End If
End With
Next
Next
End Sub