how to make a toggle button that light up

Hi All
I need to make a toggle button that light up when pushed. I could come up with this code, but it seems taken up much resources on my computer.
I need some help with a smarter and better way to structure the code.
I have tried with the "Selection with", but then I can not make the "action" work, when assigning the macro.

This is the code I am using:
---

Code:

---

Sub firepump1_Click()
If ActivePresentation.Slides(1).Shapes("firepump1").Fill.ForeColor.RGB = RGB(0, 125, 0) Then


ActivePresentation.Slides(1).Shapes("firepump1").Fill.ForeColor.RGB = RGB(102, 255, 51)
ActivePresentation.Slides(1).Shapes("firepump1").ThreeD.BevelTopType = msoBevelSoftRound
ActivePresentation.Slides(1).Shapes("firepump1").Glow.Color.RGB = RGB(153, 255, 51)
ActivePresentation.Slides(1).Shapes("firepump1").Glow.Transparency = 0.6000000238
ActivePresentation.Slides(1).Shapes("firepump1").Glow.Radius = 18
Else
ActivePresentation.Slides(1).Shapes("firepump1").Fill.ForeColor.RGB = RGB(0, 125, 0)
ActivePresentation.Slides(1).Shapes("firepump1").ThreeD.BevelTopType = msoBevelCircle
ActivePresentation.Slides(1).Shapes("firepump1").Glow.Radius = 0
End If
End Sub

---

---
Hope anyone have a fix solution.
PPT 2016

1. Add this macro to a standard module

Code:

---

Option Explicit

Sub firepump1_Click(shp As Shape)
   
    With shp
        If .Fill.ForeColor.RGB = RGB(0, 125, 0) Then
            .Fill.ForeColor.RGB = RGB(102, 255, 51)
            .ThreeD.BevelTopType = msoBevelSoftRound
            .Glow.Color.RGB = RGB(153, 255, 51)
            .Glow.Transparency = 0.6000000238
            .Glow.Radius = 18
        Else
            .Fill.ForeColor.RGB = RGB(0, 125, 0)
            .ThreeD.BevelTopType = msoBevelCircle
            .Glow.Radius = 0
        End If
    End With
End Sub

---

2. Add an 'Action' to the shape. Select [Mouse Click] and [Run Macro] and point to the one above


Attachment 20656

Hi Poul
Thanks for your code works perfectly. And now I dont have to write the same code over and over again for each button.

I have another one simular.
I have some nav buttons that have to be active when some others have to be muted. each button will show a picture of a platform.
Here I am challenged to make alle the other pictures and buttons disappear every time one button is clicked.

I can make it work with this code: (but it seems very complicated)
---

Code:

---

Sub pltA_Click()
'pic to show
ActivePresentation.Slides(1).Shapes("pltA").Visible = True
ActivePresentation.Slides(1).Shapes("knapA").ShapeStyle = msoShapeStylePreset40
ActivePresentation.Slides(1).Shapes("knapA").TextFrame.TextRange.Font.Color.RGB = RGB(0, 0, 0)
ActivePresentation.Slides(1).Shapes("knapB").ShapeStyle = msoShapeStylePreset41
ActivePresentation.Slides(1).Shapes("knapB").TextFrame.TextRange.Font.Color.RGB = RGB(255, 255, 255)
ActivePresentation.Slides(1).Shapes("knapC").ShapeStyle = msoShapeStylePreset41
ActivePresentation.Slides(1).Shapes("knapC").TextFrame.TextRange.Font.Color.RGB = RGB(255, 255, 255)
ActivePresentation.Slides(1).Shapes("knapD").ShapeStyle = msoShapeStylePreset41
ActivePresentation.Slides(1).Shapes("knapD").TextFrame.TextRange.Font.Color.RGB = RGB(255, 255, 255)
ActivePresentation.Slides(1).Shapes("knapE").ShapeStyle = msoShapeStylePreset41
ActivePresentation.Slides(1).Shapes("knapE").TextFrame.TextRange.Font.Color.RGB = RGB(255, 255, 255)
'additional to show
ActivePresentation.Slides(1).Shapes("knapAC").Visible = True
ActivePresentation.Slides(1).Shapes("knapA1").Visible = True
ActivePresentation.Slides(1).Shapes("knapA2").Visible = True
ActivePresentation.Slides(1).Shapes("knapA3").Visible = True


'knap NOT show
ActivePresentation.Slides(1).Shapes("knapBC").Visible = False
ActivePresentation.Slides(1).Shapes("knapB1").Visible = False
ActivePresentation.Slides(1).Shapes("knapB2").Visible = False
ActivePresentation.Slides(1).Shapes("knapB3").Visible = False
ActivePresentation.Slides(1).Shapes("knapB4").Visible = False
ActivePresentation.Slides(1).Shapes("knapB5").Visible = False


ActivePresentation.Slides(1).Shapes("knapCC").Visible = False
ActivePresentation.Slides(1).Shapes("knapC1").Visible = False


ActivePresentation.Slides(1).Shapes("knapDC").Visible = False
ActivePresentation.Slides(1).Shapes("knapD1").Visible = False


ActivePresentation.Slides(1).Shapes("knapEC").Visible = False
ActivePresentation.Slides(1).Shapes("knapE1").Visible = False
ActivePresentation.Slides(1).Shapes("knapE2").Visible = False
ActivePresentation.Slides(1).Shapes("knapE3").Visible = False


'Platform pic NOT show
ActivePresentation.Slides(1).Shapes("pltB").Visible = False
ActivePresentation.Slides(1).Shapes("pltC").Visible = False
ActivePresentation.Slides(1).Shapes("pltD").Visible = False
ActivePresentation.Slides(1).Shapes("pltE").Visible = False


'Level pic NOT show
ActivePresentation.Slides(1).Shapes("levelAC").Visible = False
ActivePresentation.Slides(1).Shapes("levelA1").Visible = False
ActivePresentation.Slides(1).Shapes("levelA2").Visible = False
ActivePresentation.Slides(1).Shapes("levelA3").Visible = False


'ActivePresentation.Slides(1).Shapes("levelBC").Visible = False
'ActivePresentation.Slides(1).Shapes("levelB1").Visible = False
'ActivePresentation.Slides(1).Shapes("levelB2").Visible = False
'ActivePresentation.Slides(1).Shapes("levelB3").Visible = False
'ActivePresentation.Slides(1).Shapes("levelB4").Visible = False
'ActivePresentation.Slides(1).Shapes("levelB5").Visible = False


ActivePresentation.Slides(1).Shapes("levelCC").Visible = False
ActivePresentation.Slides(1).Shapes("levelC1").Visible = False


ActivePresentation.Slides(1).Shapes("levelDC").Visible = False
ActivePresentation.Slides(1).Shapes("levelD1").Visible = False


'ActivePresentation.Slides(1).Shapes("levelEC").Visible = False
'ActivePresentation.Slides(1).Shapes("levelE1").Visible = False
'ActivePresentation.Slides(1).Shapes("levelE2").Visible = False
'ActivePresentation.Slides(1).Shapes("levelE3").Visible = False
End Sub

---

---
Attachment 20661
Hope you can assist with a easier way.

regards Jesper

1. You can use the [#] icon to add CODE .../CODE tags to paste your code between to format

2. That macro just seems to show or hide a bunch of shapes, so this is a guess, or maybe an idea for you

3. ABCD and E have an Action to run ShowHide

Primary is a 'list' of the selection buttons, and Secondary is a list of the buttons that are shown or hidden

Code:

---

Option Explicit

Const Primary As String = "A;B;C;D;E"  '  always visible, but change color
Const Secondary As String = "A1;A2;B1;B2;C1;C2;D1;D2;E1;E2"    '  visible depending on Primary

Dim aPrim As Variant, aSec As Variant

Sub ShowHide(oShp As Shape)
    Dim oShape As Shape
   
    aPrim = Split(Primary, ";")
    aSec = Split(Secondary, ";")
   
    With ActivePresentation.Slides(1)
       
        Call ActiveGreenInactiveRed(oShp)
        Select Case oShp.Name
            Case "A"
                Call OnlyShow("A1", "A2")
            Case "B"
                Call OnlyShow("B1", "B2")
            Case "C"
                Call OnlyShow("C1", "C2")
            Case "D"
                Call OnlyShow("D1", "D2")
            Case "E"
                Call OnlyShow("E1", "E2")
        End Select
    End With

End Sub

Private Sub OnlyShow(ParamArray ShowShapes() As Variant)
    Dim i As Long
    With ActivePresentation.Slides(1)
        For i = LBound(aSec) To UBound(aSec)
            .Shapes(aSec(i)).Visible = msoFalse
        Next
        For i = LBound(ShowShapes) To UBound(ShowShapes)
            .Shapes(ShowShapes(i)).Visible = msoTrue
        Next
    End With
End Sub

Private Sub ActiveGreenInactiveRed(oActiveShape As Shape)
    Dim i As Long
    With ActivePresentation.Slides(1)
        For i = LBound(aPrim) To UBound(aPrim)
            If oActiveShape.Name = aPrim(i) Then
                .Shapes(aPrim(i)).Fill.ForeColor.RGB = vbGreen
            Else
                .Shapes(aPrim(i)).Fill.ForeColor.RGB = vbRed
            End If
        Next
    End With
End Sub

---

Thanks Paul
That Code is just too advanced for me. Have no clue what is does, and how I can use it. :crying:
I am trying to make this alarm panel with an overview of a platform.
The idea is that when every you click on one character (A,B,C,D or E) you can first get the overview picture.
Then you should have the opportunity to select Levels on that platform. (Cellardeck, Level1)
So my idea what to assign a macro to all the buttons that only showed the one I needed and hided all the rest.
But it seem a lot of show and hide lines.
Attachment 20983

The picture has a left section and a right section. It appears that the right section is the overview picture for platform C?

Do A, B, C, D, and E have separate images?

Does the left section always show? Or is it part of the ABCDE pictures?

Assuming this is C, what is Level 1 and Cellar Deck? Does each 'sub image' have a separate picture?

Attachment 20984

Thanks for your reply.
It might be easier for me to send the file. That will explain the setup.
The whole platform consist of 5 platforms with walkway between them. (A,B,C,D and E) each single platform consist of levels. First level from below is cellardeck, next level upwards is called 1.level, and then 2. level...

The idea with the setup is that the control room operater, should be able to navigate through the different levels to see the alarms.

The picture the the left doesn't do anything its just for the overview.
the buttons is the navigation.
Therefore when you click on platform C and level1, all the rest of the total platform should not be displayed.

I dont think I can upload the ppt file with macros. It will not let me do so.

regards,
Jesper

You should be able to upload a PPTM file - I did in post #4

Hi Poul
I can mange to use your code on the buttons, but with adding the pictures it goes wrong.
Further I am blank with it comes to the sub-menus.

Please find attached a file with the original codes, showing the intention.


/Jesper

Sorry, but I really got lost with the overall flow, and all of the redundant / duplicated code

A simplified the 4 'Activates' and 2 of the 8 'Clicks'

Since there appears to be some consistency with the names of the shapes, this could be make even more general

Typically, something like this would have a 'database' (probably an array) of what is shown for each button

Code:

---

Option Explicit
Sub ActivateLevelDC()
    Call pvtPickupApply("flameDC", 8)
    Call pvtPickupApply("GasdetectorDC", 14)
    Call pvtPickupApply("H2SdetectorDC", 4)
End Sub
Sub ActivateLevelD1()
    Call pvtPickupApply("flameD1", 8)
    Call pvtPickupApply("GasdetectorD1", 7)
    Call pvtPickupApply("H2SdetectorD1", 3)
End Sub
Sub ActivateLevelCC()
    Call pvtPickupApply("flameCC", 8)
    Call pvtPickupApply("GasdetectorCC", 14)
    Call pvtPickupApply("H2SdetectorCC", 4)
End Sub
Sub ActivateLevelC1()
    Call pvtPickupApply("flameC1", 8)
    Call pvtPickupApply("GasdetectorC1", 4)
    Call pvtPickupApply("H2SdetectorC1", 4)
End Sub

Private Sub pvtPickupApply(sShapeName As String, iShapeCount As Long)
    Dim i As Long
       
    With ActivePresentation.Slides(1)
        For i = 1 To iShapeCount
            .Shapes(sShapeName & i & "-2").PickUp
            .Shapes(sShapeName & i).Apply
        Next I
    End With
End Sub

---

and

Code:

---

Option Explicit
Sub pltC_2_Click()
    Call pvtShowShapes("pltC-2", "knapCC-2", "knapC1-2")
    Call pvtHideShapes("pltD-2", "knapDC-2", "knapD1-2", "levelCC-2", "levelC1-2", "levelDC-2", "levelD1-2")
    Call pvtPresets("knapC-2", "knapD-2")
End Sub


Sub pltD_2_Click()
    Call pvtShowShapes("pltD-2", "knapDC-2", "knapD1-2")
    Call pvtHideShapes("pltC-2", "knapCC-2", "knapC1-2", "levelCC-2", "levelC1-2", "levelDC-2", "levelD1-2")
    Call pvtPresets("knapD-2", "knapC-2")
End Sub
 

Private Sub pvtPresets(sShapeName40 As String, sShapeName41 As String)
    With ActivePresentation.Slides(1).Shapes(sShapeName40)
        .ShapeStyle = msoShapeStylePreset40
        .TextFrame.TextRange.Font.Color.RGB = RGB(0, 0, 0)
    End With
    With ActivePresentation.Slides(1).Shapes(sShapeName41)
        .ShapeStyle = msoShapeStylePreset41
        .TextFrame.TextRange.Font.Color.RGB = RGB(255, 255, 255)
    End With
End Sub

Private Sub pvtShowShapes(ParamArray aShapes() As Variant)
    Dim i As Long
   
    For i = LBound(aShapes) To UBound(aShapes)
        ActivePresentation.Slides(1).Shapes(aShapes(i)).Visible = True
    Next i
End Sub

Private Sub pvtHideShapes(ParamArray aShapes() As Variant)
    Dim i As Long
   
    For i = LBound(aShapes) To UBound(aShapes)
        ActivePresentation.Slides(1).Shapes(aShapes(i)).Visible = False
    Next I
End Sub

---

Thanks Paul
It will take some days for me to try it out. But I will definitely look, how I can use it. And thanks for the advise.

I think it's easier to see the big picture with lower level subs. Also make a lot less code to maintain


I'm not sure about the overall flow, but if I get some spare time, I'll play with it some more


From one of your earlier screen shots and the macro it looks like

1. there are 5 'platforms'??? labeled A, B, C, D, and E with a 'L1' and a 'Cellar' in each???

2. You click A or B or C or D or E and then L1 or C to display a 'floor plan'

3. Then click sensors to make them red or yellow or ...???

4. Then click Update

Here's a possible technique that you might think about. It's only a partial approach

There are 5 Major buttons (A|B|C|D|E) and 2 Minor buttons that are always visible but 'color coded' if or if not selected

It uses the shape name to determine what to show or hide (there are other ways, but this seemed to follow the initial the closest)

I did rename two shapes and deleted some that were redundant

In the attachment if you want to see a demo, only the right side buttons work

Code:

---

Option Explicit

Public Major As String  '  A/B/C/D/E
Public Minor As String  '  1/C/X

Sub SelectMajor(shp As Shape)
    Dim oShape As Shape
   
    Major = Right(shp.Name, 1)
    Minor = "X"
    For Each oShape In ActivePresentation.Slides(1).Shapes
        With oShape
            If Left(.Name, 3) = "plt" Then
                If Right(.Name, 1) = Major Then
                    .Visible = True                            'show plt+Selected
                Else
                    .Visible = False
                End If
           
            ElseIf Len(.Name) = 6 And Left(.Name, 5) = "level" Then    'level1 and levelC buttons -- renamed
                .ShapeStyle = msoShapeStylePreset41
                .TextFrame.TextRange.Font.Color.RGB = RGB(255, 255, 255)
           
            ElseIf Left(.Name, 4) = "knap" And Right(.Name, 1) = Major Then    ' highlight selected ABCDE
                .ShapeStyle = msoShapeStylePreset40
                .TextFrame.TextRange.Font.Color.RGB = RGB(0, 0, 0)
            Else                                                                'dim rest
                .ShapeStyle = msoShapeStylePreset41
                .TextFrame.TextRange.Font.Color.RGB = RGB(255, 255, 255)
            End If
        End With
    Next
End Sub


Sub SelectMinor(shp As Shape)
    Dim oShape As Shape
   
    Minor = Right(shp.Name, 1)
    For Each oShape In ActivePresentation.Slides(1).Shapes
        With oShape
            If Left(.Name, 3) = "plt" Then
                    .Visible = False
           
            ElseIf Len(.Name) = 6 Then
                If Left(.Name, 5) = "level" Then
                    If Right(.Name, 1) = Minor Then
                        .ShapeStyle = msoShapeStylePreset40
                        .TextFrame.TextRange.Font.Color.RGB = RGB(0, 0, 0)
                    Else
                        .ShapeStyle = msoShapeStylePreset41
                        .TextFrame.TextRange.Font.Color.RGB = RGB(255, 255, 255)
                    End If
                End If
               
            ElseIf Left(.Name, 5) = "level" Then
                If Right(.Name, 2) = Major & Minor Then            'show sub level for this Major and selected Minor
                    .Visible = True
                Else
                    .Visible = False
                End If
            End If
        End With
    Next
End Sub

---