PPT页数多的时候，总等不到演讲者结束。自己反过来想，我的PPT必须每次添加进度条，让听的人心里有个数，到底ta还要忍受多少页PPT才能离开。
自己新建了一个PPT模板，添加了多个主题，填了VBA代码，保存为potm后缀的模板文件。每次编辑完PPT后，到开发工具->宏，点击运行一次就好了。
Sub AddProgressBar()
On Error Resume Next
'当前PPT文件
With ActivePresentation
'iterate through slides
'每一张幻灯片都要加
For X = 1 To .Slides.count
'delete them if shapes PB and PBtag exist
'把已有的shape都删掉，旧的
.Slides(X).Shapes("PB").Delete
.Slides(X).Shapes("PBTag").Delete
'跳过第一章幻灯片，也就是第一张不加进度条
If X = 1 Then
GoTo NextLoop
End If
'_ is next line combiner
'开始计算页数，百分比，这些性状需要放的位置
Dim margin As Double, width As Double, count As Integer, curPos As Double, curRatio As Double
count = .Slides.count
margin = 35.64
'the distance between the left border of Slide and this object
'设定进度条里两边的距离
width = .PageSetup.SlideWidth - (margin * 2) 'full width of PB
'得到进度条的最大宽度，也就是最后一页的长度，100%
curPos = X * width / count 'width of PB per Slide
'获取当前幻灯片的进度条长度
curRatio = Round(X / count, 4) * 100
'percentage of current Slide
'获得当前幻灯片的进度百分比
'Add corner-rounded rectangle
Set bar = .Slides(X).Shapes.AddShape(msoShapeRoundedRectangle, margin, -2, curPos, 3)
' bar就是当前页面进度条对象
'font color and Name of PB
'设置条的阴影效果
With bar.Shadow
.Blur = 6
.OffsetX = 1
.OffsetY = 2
.ForeColor.RGB = RGB(100, 100, 100)
End With
'设置对象的名字，和背景色
With bar
.Name = "PB"
.Fill.ForeColor.RGB = RGB(252, 255, 2)
End With
'border style of PB
'去掉边框
With bar.Line
.Visible = msoFalse
End With
'XXXXXXXXXXXXXXXX
'Add PBTag Shape
'XXXXXXXXXXXXXXXX
' 数字显示的标记的对象bartag
Set bartag = .Slides(X).Shapes.AddShape(msoShapeCloud, curPos + 9.89, 3, 62.9, 22.44)
With bartag
'.Rotation = 180 '不行字也会倒过来
.TextFrame.TextRange = X & "/" & count
.Name = "PBTag"
' 背景色
With .Fill
.ForeColor.RGB = RGB(252, 255, 2)
End With
'设置字体效果
With .TextFrame.TextRange.Font
.Size = 13
.Name = "Yu Gothic UI"
.Bold = msoTrue
.Color.RGB = RGB(100, 100, 100)
.HorizontalAlignment = msoAnchorCenter
End With
'添加阴影效果
With .Shadow
.Blur = 6
.OffsetX = 1
.OffsetY = 2
.ForeColor.RGB = RGB(100, 100, 100)
End With
'去掉边框
With .Line
.Weight = 0.5
.ForeColor.RGB = RGB(255, 235, 50)
End With
End With
NextLoop:
Next X:
End With
End Sub
Resultant Display
不足
-
PBTag的位置需要依据页数的多少，以及字体，字体的大小等，自己设置，也就是下面的，参数2和4
(msoShapeCloud, curPos + 9.89, 3, 62.9, 22.44) -
如果需要显示百分比
.TextFrame.TextRange = X & "/" & count改成下面的就可以了
.TextFrame.TextRange = curRatio
