网页编程网

用 VBA 实现在 PPT 最下边加进度条，方便查看进行到总长度的多少，根据选择的页面不同，进度条的长度也不同。

提示：进度条只是体现已播放的幻灯片张数，不是用于计时。

进度条的制作添加方法如下：

打开 PPT，按 Alt+F11，打开VBE编辑器，插入——模块，并复制下面的代码，最后单击工具栏的“运行”按钮。

Sub AddProgressBar()
    On Error Resume Next
        With ActivePresentation
              For X = 2 To .Slides.Count - 1 '第一页和最后一页不加
              .Slides(X).Shapes("PB").Delete
              Set s = .Slides(X).Shapes.AddShape(msoShapeRectangle, _
              0, .PageSetup.SlideHeight - 6, _
              X * .PageSetup.SlideWidth / .Slides.Count, 5) '条高度
              s.Fill.ForeColor.RGB = RGB(246, 202, 5) '设置颜色
              s.Name = "PB"
              Next X:
        End With
End Sub

第二、PPT播放时显示页码和总页数

Sub OnSlideShowPageChange()
    On Error GoTo Err_Handle
    ActivePresentation.Slides(ActivePresentation.SlideShowWindow _
    .View.CurrentShowPosition).Shapes("asdf").Delete
Err_Handle:
    If ActivePresentation.Slides(ActivePresentation.SlideShowWindow _
    .View.CurrentShowPosition).Shapes.Count > 3 Then
        With ActivePresentation.Slides(ActivePresentation.SlideShowWindow. _
        View.CurrentShowPosition).Shapes.AddTextbox(msoTextOrientationHorizontal, _
        ActivePresentation.PageSetup.SlideWidth - 60, _
        ActivePresentation.PageSetup.SlideHeight - 20, 100, 10)
            .Name = "asdf"
            .TextFrame.TextRange.Font.Color.RGB = RGB(144, 144, 144)
            .TextFrame.TextRange.Font.Name = "Arial"
            .TextFrame.TextRange.Font.Size = 12
            .TextFrame.TextRange.Text = Str(ActivePresentation.SlideShowWindow _
            .View.CurrentShowPosition) & "/" & Str(ActivePresentation.Slides.Count)
        End With
    End If
End Sub
 
Sub OnSlideShowTerminate()
    On Error Resume Next
    For i = 1 To ActivePresentation.Slides.Count
        ActivePresentation.Slides(i).Shapes("asdf").Delete
    Next
End Sub