如何將此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」行之後找到位於滑最高的一個，然後對其進行處理（不選擇它）。