2015-12-02 62 views
1

所以我的問題是這樣的: 我想在超過250個演示文稿(文件)中更改文本形狀的顏色。 我能做到這一點,如果發言都做這個活潑開朗:Powerpoint VBA循環遍歷文件夾中的所有演示文稿

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,執行該子文件並保存它?

在此先感謝

+0

您應該考慮接受下面的答案。參見[當某人回答我的問題時應該怎麼做](http://stackoverflow.com/help/someone-answers)。 – Rob

回答

2

更改子來:

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 

告訴谷歌:目錄和子目錄中的vba列表文件 這應該讓你任意數量的例程來獲取文件列表GS。

執行此操作的一種方法是使用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 
+0

編輯的遲來的感謝(更像是「用代碼完全重寫」),David。 –

相關問題