PowerPoint macro to toggle multi words on slide to change font size & color in order from left to right. MouseOver toggles the change

Viewed 94

I’m creating reading materials using PPT slide. Each slide contains a series of rectangle shapes containing a word - text color is black.Rectangles are named 1, 2, 3, 4, 5, 6 … Rectangle shapes run across the page. Macro MouseOver is assigned to all rectangle shape on slide. At the start of presentation: 1. several global variables are set. 2.Rectangle named 1 will increase in font size, text color to red. Mouseover on Rectangle 1, font size & font color returns to original size & color for Rectangle 1 and Rectangle 2, increase font size & change text color to red. When mouseover Rectangle 2, change font size & font color returns to original size for Rectangle 2 and for Rectangle 3, increase font size & change text color to red. In general, mouseover returns text to normal size & color and change color & size of next word in order. The order is 1, 2, 3 ... based on the name of Rectangles.

Thank you.

Trying to code with code found on website:

Update: I got StartSetUp to work. Having trouble declaring global variables - NumCnt & Last. I just discover Visual Studio Editor to type in code. Editor is a big help. Will work on MouseOver tomorrow.

Update 9/10/2022: Got it working. Need more testing. Macro is not pretty. I'm new to PPT. I learned a lot reading all the questions and answers on this site. Thank you everyone!

Update 9/11/2022: I believe it works. Closing.


    Public NumCnt As Integer
    Public Last As Integer
    Public Sub Setting(ByRef oGraphic As Shape)
        NumCnt = 1
        Last = 3
        Debug.Print "In Setting"
        Debug.Print NumCnt
        Debug.Print Last
        SetBig(ByRef oGraphic As Shape)
    End Sub
    Public Sub SetBig(ByRef oGraphic As Shape)

        Dim RGBColorBig As Long
        Dim RGBColorSmall As Long
        Dim oSld As Slide
        Dim oShp As Shape
        Dim RGBColorBig As Long
        Dim NameStr As String
        '
        'For debug
        Debug.Print "in TextHover"
        Debug.Print "Last is " Last
        Debug.Print "NumCnt is "; NumCnt; ""
        'For debug
        '
        RGBColorBig = RGB(255, 0, 0)
        RGBColorSmall = RGB(0, 0, 0)
        
        Set oSld = oGraphic.Parent
        '
        ' Find first word. Change font text size and font color
        '
        For Each oShp In oSld.Shapes
            NameStr = oShp.Name
            If NameStr = CStr(NumCnt) Then
                If oShp.HasTextFrame Then
                    If oShp.TextFrame.HasText Then
                        With oShp.TextFrame.TextRange.Font
                            .Size = 30
                            .Color.RGB = RGBColorBig
                        End With
                    End If
                End If
                Exit Sub
            End If
        Next
    End Sub
    Public Sub TextHover2(ByRef oGraphic As Shape)

        Dim oSld As Slide
        Dim oShp As Shape
        Dim RGBColorBig As Long
        Dim RGBColorSmall As Long
        Dim NameStr As String
        '
        'For debug
        Debug.Print "in TextHover"
        Debug.Print "Last is " Last
        Debug.Print "NumCnt is "; NumCnt; ""
        'For debug
        '
        RGBColorBig = RGB(255, 0, 0)
        RGBColorSmall = RGB(0, 0, 0)
   
        Set oSld = oGraphic.Parent
             
        If NumCnt = 1 Then
            NameStr = oGraphic.Name
            If NameStr = CStr(NumCnt) Then
                If oGraphic.HasTextFrame Then
                    If oGraphic.TextFrame.HasText Then
                        With oGraphic.TextFrame.TextRange.Font
                            .Size = 20
                            .Color.RGB = RGBColorSmall
                        End With
                        NumCnt = NumCnt + 1
                        '
                        'Find Next word on slide
                        'Change text font to big size and text font color to red
                        '
                        SetBig(ByRef oGraphic As Shape)
                    End If
                End If
            Else
                'End Sub
                Exit Sub
            End If
        ElseIf NumCnt > 1 Then
            NameStr = oGraphic.Name
            If NameStr = CStr(NumCnt) Then
                With oGraphic.TextFrame.TextRange.Font
                    .Size = 20
                    .Color.RGB = RGBColorSmall
                End With
                NumCnt = NumCnt + 1
                If NumCnt <= Last Then
                    '
                    'Find Next word on slide
                    'Change text font to big size and text font color to red
                    '
                    SetBig(ByRef oGraphic As Shape)
                ElseIf NumCnt >= Last Then
                    '
                    'do some Reset here
                    '
                    Debug.Print "Hello World"
                End If
            End If
        End If
    End Sub  
0 Answers
Related