博客

You are currently viewing PPT每页添加进度条

PPT每页添加进度条

最近制作一个培训用的PPT，因为图片内容多整体页数很长，就想在PPT中每页下方增加一个像视频进度条一样的，帮助观看者了解播放的进度。

效果见图下方黄色进度条

找了一下网上方法，发现用宏是最简单的

首先在制作好的PPT中按Alt+F11打开宏编写窗口

右键-插入-模块

复制代码-根据注释可修改进度条颜色、宽度、位置

修改完成后点击箭头运行或者F5 返回看PPT中以成果添加


Sub ProgressBar()

    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(246, 202, 5) 'RGB三个数值控制颜色，可用Powerpoint里的取色器来看，选中想要的颜色后将对应数值填入
       pageSHower.Line.Visible = msoFalse
        ' pageSHower.Width = i * pageStep
        ' 计算进度条长度时除去首页和隐藏的幻灯片
        pageSHower.Width = (i - 1 - k) * pageStep
       pageSHower.Top = pageHeight - 3 '减去的数值越多则越靠上，根据实际情况调节，每改一次要重新运行F5一下看效果
       pageSHower.Left = 0
       pageSHower.Height = 3 '这个值控制进度条的高度（即厚度）
        ' 删除首页和隐藏的幻灯片的进度条
        If i = 1 Or MyArray(i, 0) = 1 Then pageSHower.Delete
    Next
End Sub
标签: