Sub ProgressBar() ' by dukenuke@newsmth.net ' Sun Jul 11 00:06:13 2010 Dim mySlides As Slides Dim pageBar As ShapeRange Dim pageSHower As Shape Dim pageWidth, pageHeight, pageStep Set mySlides = Application.ActivePresentation.Slides pageWidth = Application.ActivePresentation.SlideMaster.Width pageHeight = Application.ActivePresentation.SlideMaster.Height pageStep = pageWidth / mySlides.Count On Error Resume Next For i = 2 To mySlides.Count 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(179, 162, 199) pageSHower.Line.Visible = msoFalse pageSHower.Width = i * pageStep pageSHower.Top = pageHeight - 3 pageSHower.Left = 0 pageSHower.Height = 3 Next End Sub |
颜色尺寸可以更改,现在的高度是3,在页面最下方,颜色是淡紫色。
PowerPoint 2007/2010 需要另存为带宏的演示文稿,还可以把宏按钮添加
到快速访问工具栏。
开始讲 PPT 前先运行宏(按 Alt+F8 或用快速访问工具栏),运行一次即可,
播放幻灯片时就会自动加上进度条,只有第一页不加,会自动根据当前页
面数刷新进度。
注:增减幻灯片(总页数改变)后要重新运行一次宏。
2010-9-12,对宏进行更新:
Sub ProgressBar() Dim mySlides As Slides Set mySlides = Application.ActivePresentation.Slides pageWidth = Application.ActivePresentation.SlideMaster.Width ReDim MyArray(mySlides.Count, 0) '除去首页和隐藏的幻灯片后计算进度条长度增量 On Error Resume Next For i = 1 To mySlides.Count ' 改为从1开始 If IsNull(pageBar) Or pageBar.Count = 0 Then GoTo newBar newBar: nextPage: |
WPS演示安装了vba之后同样可以使用宏制作进度条,不过要修改几个地方才能使用。
Sub ProgressBar() Dim mySlides As Slides Set mySlides = Application.ActivePresentation.Slides ' pageWidth = Application.ActivePresentation.SlideMaster.Width ReDim MyArray(mySlides.Count, 0) ' 除去首页和隐藏的幻灯片后计算进度条长度增量 On Error Resume Next For i = 1 To mySlides.Count ' 改为从1开始 ' If IsNull(pageBar) Or pageBar.Count = 0 Then GoTo newBar newBar: ' mso改为kso nextPage: |
示例:
《Marry Me》 http://v.youku.com/v_show/id_XMTg4ODY3MjE2.html
评论