PPT文档进度条添加方法.docx

VBA代码为PPT添加页码进度条打开 PPT，按 Alt+F11，打开VBE编辑器，插入——模块，并复制下面的代码，最后单击工具栏的“运行”按钮。代码一：Sub AddProgressBar()On Error Resume NextWith ActivePresentationFor X = 2 To .Slides.Count - 1 第一页和最后一页不加.Slides(X).Shapes(PB).DeleteSet s = .Slides(X).Shapes.AddShape(msoShapeRectangle, 0, .PageSetup.SlideHeight - 3, X * .PageSetup.SlideWidth / .Slides.Count, 5) 条高度s.Fill.ForeColor.RGB = RGB(0, 161, 206) 设置颜色s.Name=PBNext X:End WithEnd Sub代码二：Sub ProgressBar() by dukenuke@ 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 nextPagenewBar: Set pageSHower = mySlides.Item(i).Shapes.AddShape( _ msoShapeRectangle, 0, _ pageHeight - 3, i * pageStep, 3) pageSHower.Name = RectanglePageNumnextPage: pageSHower.Fill.ForeColor.RGB = RGB(0, 162, 206) pageSHower.Line.Visible = msoFalse pageSHower.Width = i * pageStep pageSHower.Top = pageHeight - 3 pageSHower.Left = 0 pageSHower.Height = 3 NextEnd Sub代码三：Sub ProgressBar() bydukenuke@ Sun Jul 11 00:06:13 2010 Update by oicu# 2010/9/12 20:44 对首页以及隐藏幻灯片进行处理 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 pageWidt