网站 › 『编程语言区』 › PPT VBA 加页码/总页码的比例进度条

etkane 发表于 2024-8-19 10:15

PPT VBA 加页码/总页码的比例进度条

公司电脑用不了其他工具，代码改哪里可以参考另一个帖子，还是比较简单的。
这个也是搬运加根据需要进行了改造，搬运的地址我实在不好找了，作者发现留个信息，我将备注。

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)
      On Error Resume Next
    For i = 1 To mySlides.Count '统计隐藏的幻灯片数
      ActivePresentation.Slides(i).Shapes("进度条").Delete '删除老的
      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 - 2 - j > 0 Then
      pageStep = (pageWidth - 60) / (mySlides.Count - 3 - j)
    Else
      pageStep = 0
    End If

    On Error Resume Next

    For i = 3 To mySlides.Count - 1' 改为从1开始
      k = k + MyArray(i, 0)      ' 计算当前隐藏的幻灯片数
      Set pageBar = mySlides.Item(i).Shapes.Range(Array())
      Set pageBar = _
         mySlides.Item(i).Shapes.Range(Array("进度条"))
      
      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 = "进度条"

nextPage:
      pageSHower.Fill.ForeColor.RGB = RGB(187, 222, 251)
      pageSHower.Line.Visible = msoFalse
      ' pageSHower.Width = i * pageStep
      ' 计算进度条长度时除去首页和隐藏的幻灯片
      pageSHower.Width = (i - 2 - k) * pageStep
      pageSHower.Top = pageHeight - 3
      pageSHower.Left = 0
      pageSHower.Height = 3
      ' 删除首页和隐藏的幻灯片的进度条
      If i = 1 Or MyArray(i, 0) = 1 Then pageSHower.Delete
    Next
End Sub

jiujiukeji 发表于 2024-8-20 13:25

etkane 发表于 2024-8-20 11:18
用PPT里的宏

主要是 没看出有啥效果在宏里执行了不知道是没效果还是没执行

lzspain 发表于 2024-8-19 10:46

感谢大佬分享，学习了！office的VBA功能确实强，只是某些批处理感觉比C还是要慢一点。

1270698424 发表于 2024-8-19 11:13

大佬这个怎么用啊

firethunder 发表于 2024-8-19 11:47

谢谢大佬分享！！

LuckyClover 发表于 2024-8-19 11:53

感谢分享，测试一下怎么样

jiujiukeji 发表于 2024-8-19 13:56

~不会用~~~~~~~~~~~

canghaisui 发表于 2024-8-19 16:16

谢谢大佬分享，能把用法普及一下吗，方便小白

agion 发表于 2024-8-19 21:23

谢谢大佬

etkane 发表于 2024-8-20 11:18

jiujiukeji 发表于 2024-8-19 13:56
~不会用~~~~~~~~~~~

用PPT里的宏

查看完整版本: PPT VBA 加页码/总页码的比例进度条