制作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