用于打开和编辑多个Powerpoint文件的VBA

时间:2011-09-26 05:06:39

标签: vba batch-file powerpoint powerpoint-vba

我有一个包含200多个Powerpoint文件的文件夹,我一直在努力使用宏打开每个文件,编辑它们,保存它们并在循环中关闭它们。 我已经设法为编辑部分创建代码,但是我无法创建一个代码来选择文件夹中的每个文件。使用"*.pptx"似乎不起作用,为每个文件编写具有特定文件名的代码效率非常低。

有没有人有解决方案?

Sub SaveNotesText()

Dim oPres As Presentation
Dim oSlides As Slides
Dim oSlide As Slide
Dim oShapes As Shapes
Dim oSh As Shape
Dim NotesText As String
Dim FileNum As Integer
Dim PathSep As String

#If Mac Then
    PathSep = ":"
#Else
    PathSep = "\"
#End If

Set oPres = ActivePresentation
Set oSlides = oPres.Slides

For Each oSlide In oSlides
    NotesText = NotesText & "Slide " & oSlide.SlideIndex & vbCrLf
    Set oShapes = oSlide.NotesPage.Shapes
    For Each oSh In oShapes
        If oSh.HasTextFrame Then
            If oSh.TextFrame.HasText Then
                NotesText = NotesText & oSh.TextFrame.TextRange.Text
            End If
        End If
    Next oSh
    NotesText = NotesText & vbCrLf
Next oSlide

FileNum = FreeFile
Open oPres.Path & PathSep & "NotesText.TXT" For Output As FileNum
Print #FileNum, NotesText
Close FileNum

End Sub

http://www.pptfaq.com/FAQ00274.htm

1 个答案:

答案 0 :(得分:7)

您可以使用Dir循环浏览文件夹中的所有“#.ppt#”文件,即

Public Sub DoFiles()
    Dim strFileName As String
    Dim strFolderName As String
    Dim PP As Presentation
    'set default directory here if needed
    strFolderName = "C:\temp"
    strFileName = Dir(strFolderName & "\*.ppt*")
    Do While Len(strFileName) > 0
       Set PP = Presentations.Open(strFolderName & "\" & strFileName)
        'your code
        PP.Close
        strFileName = Dir
    Loop
End Sub