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