TPE

Tavvafi@gmail.com

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

با اجرای این ماکرو نواری پایین اسلایدها در پرزنتیشن به نمایش گذاشته خواهد شد، که پیشرفت نمایش اسلایدها را به نمایش خواهد گذاشت.

Sub AddProgressBars()

    Dim X As Long
    Dim dblLeft As Double
    Dim dblTop As Double
    Dim dblheight As Double
    Dim oSh As Shape

    ' This determines how far in from left the progress bar will start:
    dblLeft = 0
    ' This determines how high (in points) the progress bar will be:
    dblheight = 12
    ' This puts the progress bar right against the bottom of the slide, no matter what its height
    dblTop = ActivePresentation.PageSetup.Slideheight - dblheight

    For X = 1 To ActivePresentation.Slides.Count
        ' Add a rectangle - it'll be formatted however you have your default object formatting set
        Set oSh = ActivePresentation.Slides(X).Shapes.AddShape(msoShapeRectangle, _
            dblLeft, _
            dblTop, _
            (X * ActivePresentation.PageSetup.Slidewidth) / ActivePresentation.Slides.Count, _
            dblheight)
        With oSh
            ' Change this to any color you like, if you like
            .Fill.ForeColor.RGB = RGB(127, 0, 0)

            ' Don't change this:
            .Name = "ThermometerBar"
        End With
    Next X

End Sub

Sub RemoveProgressBars()

    Dim X As Long

    On Error Resume Next
    For X = 1 To ActivePresentation.Slides.Count
        ActivePresentation.Slides(X).Shapes("ThermometerBar").Delete
    Next X

End Sub