Change color

[magnel]

Hello,

I am using PPT 2010 and I am trying to find and replace colors of autoshapes on a given slide. We have the feature available in MS-Word to find and replace color but we do not have it PPT. Tried the below code, but there seems to be some problem.

Dim col() As Single
Sub copycol()
Dim oshp As Shape
Dim i As Integer
On Error GoTo err:
Set oshp = ActiveWindow.Selection.ShapeRange(1)
ReDim col(1 To oshp.Fill)
For i = 1 To oshp.Fill
col(i) = oshp.Fill(i)
Next i
Exit Sub
err:
MsgBox "Select Shape"
End Sub

Sub pastecol()
Dim oshp As Shape
Dim i As Integer
On Error GoTo err:
For Each oshp In ActiveWindow.Selection.ShapeRange(1)
ReDim Preserve col(1 To oshp.Fill)
For i = 1 To oshp.Fill
oshp.Fill(i) = col(i)
Next i
Next oshp
Exit Sub
err:
MsgBox "ERROR"
End Sub

Please can you help correct the code.

[John Wilson]

Why are you (trying to) use arrays??


Dim RGBCol As Long

Sub PickUpRGB()
On Error GoTo err
RGBCol = ActiveWindow.Selection.ShapeRange(1).Fill.ForeColor.RGB
Exit Sub
err:
MsgBox "Select one shape"
End Sub

Sub ApplyIt()
Dim oshp As Shape
On Error GoTo err
For Each oshp In ActiveWindow.Selection.ShapeRange
oshp.Fill.ForeColor.RGB = RGBCol
Next oshp
Exit Sub
err:
MsgBox "ERROR"
End Sub

[magnel]

Thanks John, I was actually trying to change colors of all the shapes having the same color on the slide.

Example: If I pickup green color of one shape and apply the color to a red shape, all other shapes which is red color on the slide should turn green.

I hope the example is not confusing.

[John Wilson]

Something like this then:


Dim RGBCol As Long
Sub PickUpRGB()
On Error GoTo err
RGBCol = ActiveWindow.Selection.ShapeRange(1).Fill.ForeColor.RGB
Exit Sub
err:
MsgBox "Select one shape"
End Sub

Sub ApplyIt()
Dim oshp As Shape
Dim rgbcolRef As Long
On Error GoTo err
Set oshp = ActiveWindow.Selection.ShapeRange(1)
rgbcolRef = oshp.Fill.ForeColor.RGB
oshp.Fill.ForeColor.RGB = RGBCol
For Each oshp In ActiveWindow.Selection.SlideRange(1).Shapes
If oshp.Fill.ForeColor.RGB = rgbcolRef Then oshp.Fill.ForeColor.RGB = RGBCol
Next oshp
Exit Sub
err:
MsgBox "ERROR"
End Sub

[magnel]

Yes John, this one is giving the exact result required. Thank you so much.