Change colour of graphs in powerpoint 2003 with vba

Joined
Jan 29, 2009
Messages
4
Reaction score
0
Hi,

i got the following problems. I am trying to substitute a certain colour with another colour in all shapes and graphs in a powerpoint presentation.
At first i create inputboxes in order to ask what colour should be changed, second i create an inputbox to ask what the new colour should be.
Then the old colour is changed to the new colour in all shapes and textboxes and lines (grouped and ungrouped) in all slides. This is working fine.

But now i´m trying to change a colour in all ppt-graphs of the presentation, which is not working. I don´t have a clue how i can do this, i guess i have to use OLEformat or something similar, but I don´t know how. Can anyone help me?
Thanks and sry for the bad english...^^
This is what I got and what is working so far:



Sub change_color()
Dim oSld As Slide
Dim oShp As Shape
Dim I As Integer
Dim a1 As Integer
Dim a2 As Integer
Dim a3 As Integer
Dim n1 As Integer
Dim n2 As Integer
Dim n3 As Integer

a1 = InputBox("Color red:", "Old Color: " & "xxx.xxx.xxx")
a2 = InputBox("Color blue:", "Old Color: " & a1 & ".xxx.xxx")
a3 = InputBox("Color green:", "Old Color: " & a1 & "." & a2 & ".xxx")
n1 = InputBox("Color red:", "Old Color: " & a1 & "." & a2 & "." & a3 & " ; new color:")
n2 = InputBox("Color blue:", "Old Color: " & a1 & "." & a2 & "." & a3 & " ; new color: " & n1 & ".xxx.xxx")
n3 = InputBox("Color green:", "Old Color: " & a1 & "." & a2 & "." & a3 & " ; new color: " & n1 & "." & n2 & ".xxx")
For Each oSld In ActivePresentation.Slides
For Each oShp In oSld.Shapes
If oShp.Type = msoGroup Then
For I = 1 To oShp.GroupItems.Count


Call FindAndReColourFill(oShp.GroupItems(I), _
RGB(a1, a2, a3), RGB(n1, n2, n3), False)
Next I
Else
Call FindAndReColourFill(oShp, _
RGB(a1, a2, a3), RGB(n1, n2, n3), False)

End If
Next oShp
Next oSld
End Sub


Function FindAndReColourFill(oShp As Shape, _
oRGB As Long, oNewRGB As Long, oPattern As Long)


On Error Resume Next
If oShp.Fill.Visible Then 'filled shapes
If oShp.Fill.ForeColor.RGB = oRGB Then 'only change color if its the old one
oShp.Fill.ForeColor.RGB = oNewRGB
oShp.Fill.BackColor.RGB = RGB(255, 255, 255)
oShp.Fill.Patterned oPattern
If oShp.Line.ForeColor.RGB = oRGB Then oShp.Line.BackColor.RGB = oNewRGB
oShp.Line.ForeColor.RGB = oNewRGB
End If
ElseIf oShp.Line.ForeColor.RGB = oRGB Then
oShp.Line.BackColor.RGB = oNewRGB
oShp.Line.ForeColor.RGB = oNewRGB

End If


ElseIf oShp.Line.Visible Then 'lines
If oShp.Line.ForeColor.RGB = oRGB Then 'if line is old color
oShp.Line.BackColor.RGB = oNewRGB
oShp.Line.ForeColor.RGB = oNewRGB
End If
If oShp.TextFrame.TextRange.Font.Color = oRGB Then
oShp.TextFrame.TextRange.Font.Color = oNewRGB
End If

ElseIf oShp.Line.Visible = msoFalse Then
If oShp.TextFrame.TextRange.Font.Color = oRGB Then 'Text
oShp.TextFrame.TextRange.Font.Color = oNewRGB
End If

End If
End Function
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top