TPE

Tavvafi@gmail.com

≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡

Sub Popup(osh As Shape)
' Assign the shape's MouseOver or MouseClick Action Setting as
' Run Macro:  Popup
' Use the formatting dialog, Web Text tab to enter your popup text
' On playback, a popup will display the web text then disappear
' when you click the popup again

    Dim oPopup As Shape
    Dim oSl As Slide
    Dim dOffset As Double
    dOffset = 10

    Set oSl = osh.Parent
    ' create a rectangle for the popup
    Set oPopup = oSl.Shapes.AddShape(msoShapeRectangle, _
        osh.Left + dOffset, _
        osh.Top + dOffset, _
        osh.width, _
        osh.height)

    ' set popup shape properties here as needed
    With oPopup
        ' fill
        .Fill.ForeColor.RGB = RGB(255, 255, 200)
        ' text settings
        With .TextFrame
            .WordWrap = msoTrue
            With .TextRange
                ' text color
                .Font.Color.RGB = RGB(0, 0, 0)
                .Text = osh.AlternativeText
            End With
        End With

        ' Set action setting to Delete
        ' which will delete the new shape when the user clicks it
        .ActionSettings(ppMouseClick).Run = "Delete"
    End With

    ActivePresentation.SlideShowWindow.View.GotoSlide (oSl.SlideIndex)

End Sub

Sub Delete(osh As Shape)
    osh.Delete
End Sub