如何将此VBA应用于文件夹中的多个PPT文件

Question

我希望这个特定的代码可以在文件夹中的多个PPT文件上运行。但是，如果它打开Powerpoint文件，运行下面的代码，保存并打开下一个代码会更好。欢迎任何建议！我已经通过这个网站上的代码，但似乎无法使它适应我的代码如下（如这一个Loop through files in a folder using VBA?）

环不未遂

标志

Sub LoopThroughFiles() 
Dim MyObj As Object, MySource As Object, file As Variant 
file = Dir("c:\testfolder\") 
While (file <> "") 
    If InStr(file, "test") > 0 Then 
      MsgBox "found " & file 
      Exit Sub 
    End If 
file = Dir 
Wend 
End Sub 

现有代码

Option Explicit 

' Selects the shape that support text which is closest to the top of the slide 
' Written by Jamie Garroch of YOUpresent Ltd (http://youpresent.co.uk) 
Sub SelectHigestTextShape() 
    Dim oSld As Slide 
    Dim oShp As Shape, oShpTop As Shape 
    Dim sShpTop As Single 

    On Error Resume Next 
    Set oSld = ActiveWindow.View.Slide 
    If Err Then Exit Sub 
    On Error GoTo 0 

    ' Set the top to the bottom of the slide 
    sShpTop = ActivePresentation.PageSetup.SlideHeight 

    ' Check each shape on the slide is positioned above the stored position 
    ' Shapes not supporting text and placeholders are ignored 
    For Each oShp In oSld.Shapes 
    If oShp.Top < sShpTop And oShp.HasTextFrame And Not oShp.Type = msoPlaceholder Then 
     sShpTop = oShp.Top 
     Set oShpTop = oShp 
    End If 
    Next 

    ' Select the topmost shape 
    If Not oShpTop Is Nothing Then oShpTop.Select msoTrue 
    ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.ParagraphFormat.Alignment = ppAlignCenter 
    ' Clean up 
    Set oSld = Nothing 
    Set oShp = Nothing 
    Set oShpTop = Nothing 
End Sub 

Answer 1

这是我的SelectHigestTextShape子代码示例，但我不确定它会以多种文件的方式工作。原因是它设计为使用ACTIVE VIEW在ACTIVE PRESENTATION中选择一个文本框对象。当您循环浏览文件夹中的文件时，这些都不存在，因为您需要依次打开每个文件夹，但即使如此，选择一个形状仅仅是为了在事后关闭演示文稿的时候会是什么？我想我们真的需要知道最终目标。在您尝试的批处理类型中，选择任何内容都不是一个好主意，因为这需要对象的视图处于活动状态，这是一种调试噩梦，并且会使所有内容变慢。如果你想对某个特定的对象做些什么，最好使用对它的引用而不需要活动视图或者活动窗口（你可以不可见地打开每个文件，处理它然后关闭它）。

本示例将遍历文件夹，打开找到的每个演示文稿（不带窗口），循环显示所有幻灯片上的所有形状，向即时窗格输出幻灯片和形状的计数，然后关闭该文件：

' Loop through all PowerPoint files in a specified folder 
' Open each and then loop through each shape of each slide 
' Output a count of slides and shapes in immediate pane before closing the file 
' Modified by Jamie Garroch of YOUpresent Ltd (http://youpresent.co.uk) 
Sub LoopThroughPPTFiles() 
    Dim oPres As Presentation, oSld As Slide, oShp As Shape 
    Dim SldCount As Long, ShpCount As Long 
    Dim MyFile As String 
    Const MyFolder = "c:\testfolder\" 
    On Error GoTo errorhandler 
    MyFile = Dir(MyFolder) 
    While (MyFile <> "") 
    If Right(MyFile, 5) Like ".ppt*" Then 
     Set oPres = Presentations.Open(FileName:=MyFolder & MyFile, ReadOnly:=msoTrue, Untitled:=msoFalse, WithWindow:=msoFalse) 
     For Each oSld In oPres.Slides 
     SldCount = SldCount + 1 
     For Each oShp In oSld.Shapes 
      ShpCount = ShpCount + 1 
     Next 
     Next 
     Debug.Print oPres.Name & " has " & SldCount & " slide(s) and " & ShpCount & " shapes." 
     SldCount = 0: ShpCount = 0 
     oPres.Close 
    End If 
    MyFile = Dir 
    Wend 
    ' clean up 
    Set oPres = Nothing: Set oSld = Nothing: Set oShp = Nothing 
    Exit Sub 
errorhandler: 
    If Not oPres Is Nothing Then oPres.Close: Set oPres = Nothing 
End Sub 

您可以使用它来然后检查形状“对于每个OSHP在oSld.Shapes”行之后找到位于滑最高的一个，然后对其进行处理（不选择它）。