Question

我希望这个特定代码能够在文件夹中的多个powerpoint文件上运行。但是如果它打开powerpoint文件，运行下面的代码，保存它然后打开下一个代码会更好。欢迎任何建议！我已浏览过这个网站上的代码，但似乎无法将其改编为我的代码（例如此Loop through files in a folder using VBA?）

LOOPING ATTEMPT

标志

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

您可以使用它来检查“For each oShp In oSld.Shapes”行之后的形状，找到位于幻灯片上最高位置的那个，然后处理它（不选择它）。

如何将此VBA应用于文件夹

1 个答案: