PPT VBA 加页码
PPT只有首页不加页码，如果有首页，有目录，有尾页，加页码就比较麻烦，可以用下面的VBA实线，老页码会自动删除。其中Set pg = ActivePresentation.Slides(X).Shapes.AddTextbox(msoTextOrientationHorizontal, .Width - 55, .Height - 20, 55, 35)里面的-55，-20为右下角便宜。
For X = 3 To ActivePresentation.Slides.Count - 1 '统计隐藏的幻灯片数 3 和1分别是首页起始和最后不加。
如上。
.Text = X - 2 & "/" & ActivePresentation.Slides.Count - 3这个是页码/总页码
.Font.Size = 12 这个是字号
.Font.Color.RGB = RGB(255, 255, 255) 这个是颜色
Sub 加页码()
On Error Resume Next
For X = 1 To ActivePresentation.Slides.Count'统计隐藏的幻灯片数
ActivePresentation.Slides(X).Shapes("页码").Delete
Next
For X = 3 To ActivePresentation.Slides.Count - 1 '统计隐藏的幻灯片数
With Application.ActivePresentation.SlideMaster
Set pg = ActivePresentation.Slides(X).Shapes.AddTextbox(msoTextOrientationHorizontal, .Width - 55, .Height - 20, 55, 35)
End With
pg.Name = "页码"
With pg.TextFrame.TextRange
.Text = X - 2 & "/" & ActivePresentation.Slides.Count - 3
.Font.Size = 12
.Font.Color.RGB = RGB(255, 255, 255)
End With
pg.TextFrame.HorizontalAnchor = msoAnchorCenter
pg.TextFrame.VerticalAnchor = mmsoAnchorMiddle
Next
End Sub
更新，加了个隐藏页判断，和另一个加进度条呼应。
Sub 加页码2()
前部不加页码数 = 2'可视页
后部不加页码数 = 1'可视页
k = 1
m = 0
On Error Resume Next
For x = 1 To ActivePresentation.Slides.Count
ActivePresentation.Slides(x).Shapes("页码").Delete
If ActivePresentation.Slides(x).SlideShowTransition.Hidden = msoFalse Then
m = m + 1
End If
Next
m = m - 前部不加页码数 - 后部不加页码数
For x = 1 + 前部不加页码数 To ActivePresentation.Slides.Count - 后部不加页码数
With Application.ActivePresentation.SlideMaster
Set pg = ActivePresentation.Slides(x).Shapes.AddTextbox(msoTextOrientationHorizontal, .Width - 55, .Height - 20, 55, 35)
End With
pg.Name = "页码"
pg.TextFrame.HorizontalAnchor = msoAnchorCenter
pg.TextFrame.VerticalAnchor = mmsoAnchorMiddle
If ActivePresentation.Slides(x).SlideShowTransition.Hidden = msoTrue Then
pg.Delete
Else
With pg.TextFrame.TextRange
.Text = k & "/" & m
.Font.Size = 12
.Font.Color.RGB = RGB(255, 255, 255)
k = k + 1
End With
End If
Next
End Sub
页:
[1]