制作PPT进度条

为了美观PPT，然后在前人基础上改了个进度条，用宏命令完成，用OFFICE2010记得用启动宏的pptm模式保存PPT文件，不然宏代码不会保存。

按ALT+F8 创建一个宏 填入下面代码 运行下就得到了进度条。注：添加或删减页面，需要手动运行下宏，执行进度条更新

效果图：





代码：

Sub ProgressBar()

' by dukenuke@newsmth.net

' Sun Jul 11 00:06:13 2010

'

' Update by oicu#lsxk.org

' 2010/9/12 20:44

' 对首页以及隐藏幻灯片进行处理

'

' Upadte by mxio

' 2011/11/23

' 修改属性下移一层，第二页也不显示进度条

    Dim mySlides As Slides

    Dim pageBar As ShapeRange

    Dim pageSHower As Shape

    Dim pageWidth, pageHeight, pageStep

    Dim MyArray() As Variant  '增加一个数组以便统计隐藏的幻灯片

    Dim i, j, k

    j = 0

    k = 0

    Set mySlides = Application.ActivePresentation.Slides

    pageWidth = Application.ActivePresentation.SlideMaster.Width

    pageHeight = Application.ActivePresentation.SlideMaster.Height

    ' pageStep = pageWidth / mySlides.Count

    ReDim MyArray(mySlides.Count, 0)

   

    For i = 1 To mySlides.Count '统计隐藏的幻灯片数

        If mySlides.Item(i).SlideShowTransition.Hidden = True Then

            j = j + 1

            MyArray(i, 0) = 1

        Else

            MyArray(i, 0) = 0

        End If

    Next

    '除去首页和隐藏的幻灯片后计算进度条长度增量

    If mySlides.Count - 1 - j > 0 Then

        pageStep = pageWidth / (mySlides.Count - 1 - j)

    Else

        pageStep = 0

    End If

    On Error Resume Next

    For i = 1 To mySlides.Count    ' 改为从1开始

        k = k + MyArray(i, 0)      ' 计算当前隐藏的幻灯片数

        Set pageBar = mySlides.Item(i).Shapes.Range(Array())

        Set pageBar = _

           mySlides.Item(i).Shapes.Range(Array("RectanglePageNum"))

        If IsNull(pageBar) Or pageBar.Count = 0 Then GoTo newBar

        Set pageSHower = pageBar.Item(1)

        GoTo nextPage

newBar:

        Set pageSHower = mySlides.Item(i).Shapes.AddShape( _

                           msoShapeRectangle, 0, _

                           pageHeight - 3, i * pageStep, 3)

        pageSHower.Name = "RectanglePageNum"

nextPage:

        pageSHower.Fill.ForeColor.RGB = RGB(64, 64, 64)

        pageSHower.Line.Visible = msoFalse

        ' pageSHower.Width = i * pageStep

        ' 计算进度条长度时除去首页和隐藏的幻灯片

        pageSHower.Width = (i - 1 - k) * pageStep * 0.74

        pageSHower.Top = pageHeight - 27

        pageSHower.Left = 74

        pageSHower.Height = 18

        pageSHower.ZOrder msoSendBackward

        ' 删除首页和隐藏的幻灯片的进度条

        If i = 1 Or i = 2 Or MyArray(i, 0) = 1 Then pageSHower.Delete

    Next

End Sub