Consulting

Page 2 of 2 FirstFirst 1 2
Results 21 to 29 of 29

Thread: Change Fill color using VBA in PowerPoint

  1. #21
    VBAX Sage
    Joined
    Apr 2007
    Posts
    7,978
    Location
    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
    Attached Files Attached Files
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  2. #22
    Thanks sir,

    Yes. This is what I exactly wanted.

  3. #23
    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).
    Attached Files Attached Files
    Last edited by dibyendu2280; 05-21-2021 at 12:16 PM.

  4. #24
    VBAX Sage
    Joined
    Apr 2007
    Posts
    7,978
    Location
    Original color remains

    That can be changed
    Attached Files Attached Files
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

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

  6. #26
    VBAX Sage
    Joined
    Apr 2007
    Posts
    7,978
    Location
    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
    Attached Files Attached Files
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  7. #27
    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.

  8. #28
    VBAX Sage
    Joined
    Apr 2007
    Posts
    7,978
    Location
    Sorry, the way it's written it changes all shapes of the designated type
    Last edited by Paul_Hossler; 07-15-2021 at 12:38 PM.
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  9. #29
    VBAX Regular
    Joined
    Sep 2020
    Posts
    26
    Location
    Wonderful code.
    Sir I insert a custom shape (ie by merging circle & rectangle shape) but not replacing the octagons.
    Attached Files Attached Files

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •