Consulting

Results 1 to 6 of 6

Thread: Change colour of a custem shape on all slides

  1. #1

    Change colour of a custem shape on all slides

    Hi there.

    I have a problem with a custom shape that I want to change color on all slides.
    I found this code in another post and its working on the standart shape. But if a change the shape, I cant finde the name so I can get it working.
    What is the way to change the code msoShapeIsoscelesTriangle to the name of the shape insted?


    Sub addColorTriangle_1()
        Dim oPres As Presentation
        Dim oShape As Shape
        Dim oSlide As Slide
        Dim j As Long
        Dim r As Long
        Dim g As Long
        Dim b As Long
    Set oPres = ActivePresentation
    For Each oSlide In oPres.Slides
        For Each oShape In oSlide.Shapes
            If oShape.Type = msoAutoShape Then
                If oShape.AutoShapeType = msoShapeIsoscelesTriangle Then
                    oShape.Fill.ForeColor.RGB = RGB(50, 50, 50)
                End If
            End If
        Next
        Next
    End Sub
    Attached Files Attached Files
    Last edited by Aussiebear; 03-31-2024 at 03:50 PM. Reason: Added code tags to supplied code

  2. #2
    if you are looking for a triangle, check the shape's Node count (triangles have 4 Node.Count)
    Sub addColorhexagon_1()
    Dim oPres As Presentation
    Dim oShape As Shape
    Dim oSlide As Slide
    Dim j As Long
    Dim r As Long
    Dim g As Long
    Dim b As Long
    Set oPres = ActivePresentation
    For Each oSlide In oPres.Slides
        For Each oShape In oSlide.Shapes
            If oShape.Nodes.Count = 4 Then
                oShape.Fill.ForeColor.RGB = RGB(50, 50, 50)
            End If
        Next
        Exit For
    Next
    End Sub

  3. #3
    Hi there.

    I like the second code, because it work in all slides, but it need to call the name of the osld.Shapes("GoogleShape1") like in the first code, so how to rewrite it?


    Sub changedcolor()
    Dim hshp As Shape
    Dim osld As Slide
    Dim j As Long
    Dim r As Long
    Dim g As Long
    Dim b As Long
    Set osld = ActivePresentation.Slides(1)
    Set hshp = osld.Shapes("GoogleShape1")
    If hshp.Fill.ForeColor.RGB = RGB(255, 255, 255) Then
         hshp.Fill.ForeColor.RGB = RGB(50, 50, 50)
         hshp.Fill.Solid
    End If
    End Sub
    
    Sub addColorhexagon_1()
    Dim oPres As Presentation
    Dim oShape As Shape
    Dim oSlide As Slide
    Dim j As Long
    Dim r As Long
    Dim g As Long
    Dim b As Long
    Set oPres = ActivePresentation
    For Each oSlide In oPres.Slides
        For Each oShape In oSlide.Shapes
            If oShape.Type = msoAutoShape Then
                If oShape.AutoShapeType = msoShapeIsoscelesTriangle Then
                    oShape.Fill.ForeColor.RGB = RGB(50, 50, 50)
                End If
           End If
        Next
        Next
    End Sub

  4. #4
    Sub changedcolor()
    Dim hshp As Shape
    Dim osld As Slide
    Dim j As Long
    Dim r As Long
    Dim g As Long
    Dim b As Long
    Set osld = ActivePresentation.Slides(1)
    For Each hshp In osld.Shapes
        With hshp
            If .Name Like "Google*" Then
                .Fill.ForeColor.RGB = RGB(50, 50, 50)
                .Fill.Solid
            End If
        End With
    Next
    End Sub

  5. #5
    Hi arnelgp, thanks its easy to call the shape with thise, but it only work for slide 1, not all of the slides. How to make it do that

    Sub changedcolor()
    Dim hshp As Shape
    Dim osld As Slide
    Dim j As Long
    Dim r As Long
    Dim g As Long
    Dim b As Long
    Set osld = ActivePresentation.Slides(1)
    For Each hshp In osld.Shapes
        With hshp
            If .Name Like "Google*" Then
                .Fill.ForeColor.RGB = RGB(50, 50, 50)
                .Fill.Solid
            End If
        End With
    Next
    End Sub
    Last edited by Aussiebear; 04-02-2024 at 02:55 AM. Reason: Added code tags to supplied code

  6. #6
    VBAX Regular
    Joined
    Sep 2023
    Posts
    99
    Location
    You just have to loop through the slides in the presentation, like:

    Sub changedcolor()
    Dim hshp As Shape
    Dim osld As Slide
    For Each osld In ActivePresentation.Slides
        For Each hshp In osld.Shapes
            With hshp
                If .Name Like "Google*" Then
                    .Fill.ForeColor.RGB = RGB(50, 50, 50)
                    .Fill.Solid
                End If
            End With
        Next hshp
    Next osld
    End Sub
    edit: code formatting

Posting Permissions

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