2015-12-02 208 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。 –

相关问题