Powerpoint VBA 循环遍历文件夹中的所有演示文稿

Question

所以我的问题是： 我想在 250 多个演示文稿（文件）中更改文本形状的颜色。 如果演示文稿处于活动状态并打开，我可以这样做：

Sub ChangeShapeColor()
    Dim oSh As Shape
    Dim oSl As Slide
    Dim prs As Presentation

    For Each prs In Presentations

        For Each oSl In ActivePresentation.Slides

            For Each oSh In oSl.Shapes

                If oSh.Fill.ForeColor.RGB = RGB(84, 133, 192) Then
                oSh.Fill.ForeColor.RGB = RGB(0, 51, 204)
                oSh.Fill.Transparency = 0.4
                End If

                If oSh.Fill.ForeColor.RGB = RGB(202, 24, 24) Then
                oSh.Fill.ForeColor.RGB = RGB(212, 10, 10)
                oSh.Fill.Transparency = 0.4
                End If

            Next oSh
        Next oSl
    Next prs
End Sub

但是，所有文件都存储在一个文件夹中，然后是多个子文件夹。

如何调整代码，使 vba 在循环中逐步打开特定文件夹 C://xyz/xyx/presentations 中的所有其他演示文稿，执行子程序并保存它？

提前致谢

Answer 1

将子改为：

Sub ChangeShapeColor(oPres as Presentation)

Dim oSh As Shape
Dim oSl As Slide

For Each oSl In oPres.Slides

    For Each oSh In oSl.Shapes

        If oSh.Fill.ForeColor.RGB = RGB(84, 133, 192) Then
        oSh.Fill.ForeColor.RGB = RGB(0, 51, 204)
        oSh.Fill.Transparency = 0.4
        End If

        If oSh.Fill.ForeColor.RGB = RGB(202, 24, 24) Then
        oSh.Fill.ForeColor.RGB = RGB(212, 10, 10)
        oSh.Fill.Transparency = 0.4
        End If

    Next oSh
Next oSl

End Sub

然后编写一个例程，遍历您选择的子目录和所有子目录，并且对于找到的每个演示文稿，

Set oPres = Presentations.Open(path_to_presentation_file)
Call ChangeShapeColor(oPres)
oPres.Close

告诉 Google：vba 列出目录和子目录中的文件 这应该让您获得任意数量的例程来获取文件列表。

一种方法是在循环中使用Dir 函数。这不会扫描子文件夹，您需要一种不同的方法。

path = ""
filename = Dir(path)   'Get the first file
While filename <> ""
    'Avoid errors if the file cannot be opened by PPT, i.e., it is a DOCX or some other format
    On Error Resume Next
    filename = path & filename
    Set oPres = Presentations.Open(filename, WithWindow:=False)
    If Err.Number <> 0 Then
        Debug.Print "Unable to open " & filename
    End If
    On Error GoTo 0  ' Resume normal error handling
    Call ChangeShapeColor(oPres)
    oPres.Close
    filename = Dir()  'Get the next file in the folder
Wend