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/presentation, выполняет суб и сохраняет его?

Заранее спасибо

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 

Затем написать программу, которая перебирает выбранной поддиректории и все SUBDIRS прочь что и для каждой презентации найдено,

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