PPT VBA 加页码

etkane

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)   这个是颜色

[Visual Basic] 纯文本查看 复制代码

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

etkane

更新，加了个隐藏页判断，和另一个加进度条呼应。

[Visual Basic] 纯文本查看 复制代码

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