Change Fill color using VBA in PowerPoint

[Paul_Hossler]

You need to work out the math a little better

Is this what you wanted?

Private Sub pvtChangeAutoShapeType(o As Shape)
    Dim CenterTop As Double, CenterLeft As Double    
    With o
        If .Type <> msoAutoShape Then Exit Sub
        If .AutoShapeType <> tShapeToChange Then Exit Sub
        .AutoShapeType = tShapeAfterChange        
        CenterTop = .Top + .Height / 2#
        CenterLeft = .Left + .Width / 2#       
        .Height = oShapeAfterChange.Height
        .Width = oShapeAfterChange.Width                        
        .Left = CenterLeft - oShapeAfterChange.Width / 2#
        .Top = CenterTop - oShapeAfterChange.Height / 2#
    End With
End Sub

[dibyendu2280]

Thanks sir,

Yes. This is what I exactly wanted.

[dibyendu2280]

Thanks Sir @Paul_Hossler

The above micro works on the basis of shape type ie rectangle/diamond/hexagon/heptagon.
Now in below presentation there are two different size rectangular shape(one black-10 qty & other orange-10 qty).
So when I want to change orange color rectangle(small) only & run the code it changes all rectangular shapes(black-big one also).


So is it possible to some modification in micros so that the above problem solve or can I replace the shape by shape id ie RectangleBottom1, RectangleBottom2, RectangleBottom3
ie Shapes("RectangleBottom" & j) &
j = 1 to 10
next j


So that, finally I can change small size rectangle shape only without disturbing other rectangle shape(black-big).

[Paul_Hossler]

Original color remains

That can be changed

[dibyendu2280]

Thanks Sir @Paul_Hossler,
Now perfectly working. You are a genius moreover most helpful person for me. May god bless you.

[Paul_Hossler]

Try ver 10

I allows the shape to be replaced to be selected within a grouped shape

There was some code in about changing the destination color that I wasn't sure about so it's commented out

[dibyendu2280]

Thanks Sir,

Its perfectly working.
I used Pickup & Apply for copy color & shape property of inserted shape to apply destination shape.
In above code you select the shape to be changed by similar color & shape but is it possible to add another criteria shape id(shape name ie rectangle) as per example there are eight shapes rectangle1, rectangle2, rectangle3, rectangle4,rectangleOuter1, rectangleOuter2, rectangleOuter3, rectangleOuter4 all are same size & same color.
Now I want to change only rectangle1, rectangle2, rectangle3, rectangle4 shapes. Above code change all shapes.

[Paul_Hossler]

Sorry, the way it's written it changes all shapes of the designated type

[Jhon90]

Wonderful code.
Sir I insert a custom shape (ie by merging circle & rectangle shape) but not replacing the octagons.

[papuapu]

I read the solution(post: Change Fill color using VBA in PowerPoint) you had given in the post. I have one question to you. I insert a freeform shape to replace other shape but not its not replace with freeform shape. It will be huge help if you edit the code to get such result. It working with autoshape only. I want to insert my customize shape. Thanking you.

[Paul_Hossler]

I think Freeform shapes might be tricky, but try this version

[papuapu]

Sir, Slide1 is missing from file.

[Paul_Hossler]

Made changes to try and test

I copied Slide 1

[papuapu]

Sir, I tried to replace Heptagon shape with freeform 7 shape but it not replaced the heptagon shape.

[Paul_Hossler]

Sorry, the macros work by changing the AutoShapeType, and there's no easy way to change an auto shape to a non-autoshape without copy/pasting

Maybe some one will have an idea

[papuapu]

Sir @Paul_Hossler, hope you are doing well. Sir I need some help to implement some feature to this beautiful code. This Code replace shape keeping their center points constant. But I want to add some offset to the shape to be replaced. for better understanding I upload example file. Any solution will be highly appreciable.