how to make a toggle button that light up

[jesper]

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:
---

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

[Paul_Hossler]

1. Add this macro to a standard module





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


20656

[jesper]

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)
---

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
---
20661
Hope you can assist with a easier way.

regards Jesper

[Paul_Hossler]

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



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

[jesper]

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.
20983

[Paul_Hossler]

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?

20984

[jesper]

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

[Paul_Hossler]

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

[jesper]

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

[Paul_Hossler]

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




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




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

[jesper]

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.

[Paul_Hossler]

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

[Paul_Hossler]

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




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