Consulting

Results 1 to 13 of 13

Thread: how to make a toggle button that light up

  1. #1
    VBAX Regular
    Joined
    Oct 2017
    Posts
    11
    Location

    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:
    ---
    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
    Last edited by Paul_Hossler; 10-15-2017 at 07:46 AM. Reason: Added CODE tags - use the [#] icon

  2. #2
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    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


    Capture.JPG
    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

  3. #3
    VBAX Regular
    Joined
    Oct 2017
    Posts
    11
    Location
    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
    ---
    Udklip.JPG
    Hope you can assist with a easier way.

    regards Jesper
    Last edited by Paul_Hossler; 10-15-2017 at 03:27 PM. Reason: Added CODE tags

  4. #4
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    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
    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. #5
    VBAX Regular
    Joined
    Oct 2017
    Posts
    11
    Location

    Thanks for code

    Thanks Paul
    That Code is just too advanced for me. Have no clue what is does, and how I can use it.
    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.
    Udklip.JPG

  6. #6
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    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?

    Capture.JPG
    ---------------------------------------------------------------------------------------------------------------------

    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. #7
    VBAX Regular
    Joined
    Oct 2017
    Posts
    11
    Location
    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

  8. #8
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    You should be able to upload a PPTM file - I did in post #4
    ---------------------------------------------------------------------------------------------------------------------

    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. #9
    VBAX Regular
    Joined
    Oct 2017
    Posts
    11
    Location

    Alarm panel

    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
    Attached Files Attached Files

  10. #10
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    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
    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

  11. #11
    VBAX Regular
    Joined
    Oct 2017
    Posts
    11
    Location
    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.

  12. #12
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    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


    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

  13. #13
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    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
    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

Posting Permissions

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