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中的所有其他演示文稿，执行sub并保存它？

提前致谢

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
    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(path)  'Get the next file in the folder
Wend

Powerpoint VBA循环遍历文件夹

1 个答案: