Powerpoint VBA Macro for changing color

Question

I was surprised that no one has asked this question yet, maybe people are not as incapable as me in programming:

I want to program a button in PowerPoint that either changes the color by clicking it or when a certain number is inserted.

I've got this:

Dim clickCount As Integer

Sub ChangeButtonColor()
    Dim btn As Shape
    Set btn = ActivePresentation.Slides(1).Shapes("Button2") ' Button2 is my button
    
    clickCount = clickCount + 1
    Select Case clickCount
        Case 1
            btn.Fill.ForeColor.RGB = RGB(139, 0, 0) ' dark red
        Case 2
            btn.Fill.ForeColor.RGB = RGB(255, 0, 0) ' red
        Case 3
            btn.Fill.ForeColor.RGB = RGB(255, 165, 0) ' orange
        Case 4
            btn.Fill.ForeColor.RGB = RGB(255, 255, 0) ' yellow
        Case 5
            btn.Fill.ForeColor.RGB = RGB(0, 255, 0) ' green
        Case Else
            btn.Fill.Visible = msoFalse ' transparent fill
            clickCount = 0 ' set clickCount back to 0
    End Select
End Sub

Can someone help me and tell me where the error is? In my opinion the loop should be alright, shouldn't it?

Thanks in advance!

I tried it by doing it with a macro. I don't think that there's another way, if yes let me know.

I already tried it in shapes and interactive buttons but both didnt't work. Perplexity proposed me also a loop with 5 cases and without the else case but nothing of then has worked.

At least when I assign the macro to an interactive button frame gets colored for a sec by clicking it,I don't even know if it's normal.

If I understand it right it should be something with the clickCount right?

Black cat · Accepted Answer · 2024-11-15 11:24:57Z

In Shape the foreground and background color can be achieved through the OLEObject property. Additionally to keep the click count it should be defined Static.
After coloring to return back to black avoid the green color appears twice.

Static clickCount As Integer

Sub ChangeButtonColor()
    Dim btn As Shape
    Set btn = ActivePresentation.Slides(1).Shapes("Button2") ' Button2 is my button
    
    clickCount = clickCount + 1
    Select Case clickCount
        Case 1
            btn.Oleformat.Object.Forecolor = RGB(139, 0, 0) ' dark red
        Case 2
            btn.Oleformat.Object.Forecolor = RGB(255, 0, 0) ' red
        Case 3
            btn.Oleformat.Object.Forecolor = RGB(255, 165, 0) ' orange
        Case 4
            btn.Oleformat.Object.Forecolor = RGB(255, 255, 0) ' yellow
        Case 5
            btn.Oleformat.Object.Forecolor = RGB(0, 255, 0) ' green
        Case Else
            btn.Fill.Visible = msoFalse ' transparent fill
            clickCount = 0 ' set clickCount back to 0
            btn.Oleformat.Object.Forecolor = RGB(0, 0, 0)
    End Select
End Sub

Ike · Accepted Answer · 2024-11-15 13:34:46Z

0

I suppose you are using an ActiveX-Commandbutton.

Then you can't use the shape directly - but its OLE component

Sub ChangeButtonColor()
    Dim btn As CommandButton
    Set btn = ActivePresentation.Slides(1).Shapes("Button2").OLEFormat.Object
    
    clickCount = clickCount + 1
    Select Case clickCount
        Case 1
            btn.ForeColor = RGB(139, 0, 0)  ' dark red
        Case 2
            btn.ForeColor = RGB(255, 0, 0) ' red
        Case 3
            btn.ForeColor = RGB(255, 165, 0) ' orange
        Case 4
            btn.ForeColor = RGB(255, 255, 0) ' yellow
        Case 5
            btn.ForeColor = RGB(0, 255, 0) ' green
        Case Else
            btn.ForeColor = msoFalse ' transparent fill
            clickCount = 0 ' set clickCount back to 0
    End Select
End Sub

Refactored solution w/o select case

Sub ChangeButtonColor()
    
    'Configuration of colors
    Dim arrColors(5) As Long
    arrColors(1) = RGB(139, 0, 0)  ' dark red
    arrColors(2) = RGB(255, 0, 0) ' red
    arrColors(3) = RGB(255, 165, 0) ' orange
    arrColors(4) = RGB(255, 255, 0) ' yellow
    arrColors(5) = RGB(0, 255, 0) ' green
            
    Dim btn As CommandButton
    Set btn = ActivePresentation.Slides(1).Shapes("Button2").OLEFormat.Object

    clickCount = clickCount + 1
    If clickCount > Ubound(arrColors) Then clickCount = 0 ' set clickCount back to 0

    btn.ForeColor = arrColors(clickCount)
   
End Sub

edited Nov 15, 2024 at 13:34

answered Nov 15, 2024 at 11:16

Ike

13.4k6 gold badges20 silver badges38 bronze badges

3 Comments

VBasic2008 Over a year ago

A bit of nitpicking: You could implement a variable e,g, Dim SelectedColor As Long for the colors to be used instead of btn.ForeColor. Then you could finish after the Select statement with ActivePresentation.Slides(1).Shapes("Button2").OLEFormat.Object.ForeColor = SelectedColor.

VBasic2008 Over a year ago

Aren't RGB(0, 0, 0) and msoFalse the same?

Ike Over a year ago

@VBasic2008: Select case could be avoided at all by using an array holding the RGB-values. But I didn't felt to refactor the code ...

VBasic2008 · Accepted Answer · 2024-11-16 14:17:38Z

Cycle Colors When Clicking Action Button

Main

Sub CycleButtonColor()
    
    ' Define constants.
    Const SLIDE_ID As Variant = 1
    Const SHAPE_ID As Variant = "Button2"
    Dim COLOR_LIST() As Variant: COLOR_LIST = VBA.Array( _
        RGB(139, 0, 0), vbRed, RGB(255, 165, 0), vbYellow, vbGreen)
    Const NO_COLOR_INDEX As Long = 0
    Const TRANSPARENT_BEFORE_INDEX As Long = 0
   
    ' Cycle color.
    With ActivePresentation.Slides(SLIDE_ID).Shapes(SHAPE_ID).Fill.ForeColor
        Dim NewColor As Long
        NewColor = GetCycledInteger(.RGB, COLOR_LIST, NO_COLOR_INDEX)
        If NewColor = COLOR_LIST(TRANSPARENT_BEFORE_INDEX) Then
            If .Parent.Visible Then
                .Parent.Visible = msoFalse
                Exit Sub
            End If
        End If
        .RGB = NewColor
    End With

End Sub

Help

Function GetCycledInteger( _
    ByVal CurrentInteger As Long, _
    IntegersZeroBased() As Variant, _
    Optional ByVal NoMatchIndex As Long = 0) _
As Long
    
    Dim UpperLimit As Long: UpperLimit = UBound(IntegersZeroBased)
    Dim NewInteger As Long: NewInteger = NoMatchIndex
    
    Dim n As Long
    
    For n = 0 To UpperLimit
        If IntegersZeroBased(n) = CurrentInteger Then
            NewInteger = IntegersZeroBased((n + 1) Mod (UpperLimit + 1))
            Exit For
        End If
    Next n

    GetCycledInteger = NewInteger

End Function

Collectives™ on Stack Overflow

Powerpoint VBA Macro for changing color

3 Answers 3

Comments

3 Comments

Cycle Colors When Clicking Action Button

Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

3 Answers 3

Comments

3 Comments

Cycle Colors When Clicking Action Button

Comments

Your Answer

Sign up or log in

Post as a guest

Related