Sub ProgressBar()
On Error Resume Next
With ActivePresentation
For X=1 To .Slides.Count '首页尾页都加
.Slides(X).Shapes("PB").Delete
Set s = .Slides(X).Shapes.AddShape(msoShapeRectangle, _
0, 0, _
X * .PageSetup.SlideWidth / .Slides.Count, 10) '条高度
s.Fill.ForeColor.RGB = RGB(251, 128, 114)'条颜色
s.Line.Visible =0
s.Name ="PB"
Next X:
End With
End Sub
2.2 进度条在页面底部
如图所示,
1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub ProgressBar()
On Error Resume Next
With ActivePresentation
For X=1 To .Slides.Count '首页尾页都加
.Slides(X).Shapes("PB").Delete
Set s = .Slides(X).Shapes.AddShape(msoShapeRectangle, _
0, .PageSetup.SlideHeight - 10, _
X * .PageSetup.SlideWidth / .Slides.Count, 10) '条高度
s.Fill.ForeColor.RGB = RGB(251, 128, 114)'条颜色
s.Line.Visible =0
s.Name ="PB"
Next X:
End With
End Sub