ppt进度条制作，vba语言

Question

怎样在PPt每页指定位置添加一个反应翻页进度的进度条，求一个vba的模板

Answer 1

由人工智能和答主提供，可以参考如下，如果回答的不正确，及时评论区回复，我追加回答，谢谢。
以下是一个简单的 VBA 模板，用于在 PowerPoint 每一页的指定位置添加一个反应翻页进度的进度条。在这个例子中，我使用了 ActiveX 控件中的水平滚动条作为进度条。请注意，这是一个基本的示例，你可能需要根据你的具体需求进行定制。

在 PowerPoint 中按下 Alt + F11 打开 VBA 编辑器，然后在 VBA 编辑器中插入一个新的模块，并将以下代码粘贴到该模块中：

Dim progressBar As Object

Sub AddProgressBar()
    ' 在每一页的指定位置添加进度条
    Dim slide As slide
    Dim shapeTop As Double
    Dim shapeLeft As Double
    
    ' 指定进度条的位置（在这里，我使用了每页的右下角）
    shapeTop = ActiveWindow.Height - 50
    shapeLeft = ActiveWindow.Width - 200
    
    ' 循环处理每一页
    For Each slide In ActivePresentation.Slides
        ' 在每一页添加一个水平滚动条
        Set progressBar = slide.Shapes.AddOLEObject(ClassType:="Forms.ScrollBar.1", _
            Left:=shapeLeft, Top:=shapeTop, Width:=150, Height:=20)
        
        ' 配置滚动条的属性
        With progressBar.OLEFormat.Object
            .Min = 1
            .Max = ActivePresentation.Slides.Count
            .SmallChange = 1
            .LargeChange = 1
            .LinkedCell = "A1" ' 这里用一个单元格来保存滚动条的值
        End With
        
        ' 将滚动条所在的单元格设置为透明
        progressBar.Fill.Transparency = 1
        
        ' 更新位置以适应下一页
        shapeLeft = shapeLeft - 200
    Next slide
End Sub

Sub UpdateProgressBar(slideIndex As Integer)
    ' 更新进度条的值
    If Not progressBar Is Nothing Then
        progressBar.OLEFormat.Object.Value = slideIndex
    End If
End Sub

Sub OnSlideShowPageChange(SW As SlideShowWindow)
    ' 在幻灯片放映时更新进度条
    UpdateProgressBar SW.View.slide.Index
End Sub

然后运行 AddProgressBar 这个宏，它将在每一页的指定位置添加一个进度条。当你放映幻灯片时，进度条会随着页面的切换而更新。

请注意，这只是一个简单的演示，你可能需要根据你的具体需求对代码进行调整和扩展。