如何將PowerPoint幻燈片筆記導出到單個文本文件？

Question

通過一些研究，我碰到這個VBA代碼來訪問以下網站： http://www.pptfaq.com/FAQ00481_Export_the_notes_text_of_a_presentation.htm

Sub ExportNotesText() 

Dim oSlides As Slides 
Dim oSl As Slide 
Dim oSh As Shape 
Dim strNotesText As String 
Dim strFileName As String 
Dim intFileNum As Integer 
Dim lngReturn As Long 

' Get a filename to store the collected text 
strFileName = InputBox("Enter the full path and name of file to extract notes text to", "Output file?") 

' did user cancel? 
If strFileName = "" Then 
    Exit Sub 
End If 

' is the path valid? crude but effective test: try to create the file. 
intFileNum = FreeFile() 
On Error Resume Next 
Open strFileName For Output As intFileNum 
If Err.Number <> 0 Then  ' we have a problem 
    MsgBox "Couldn't create the file: " & strFileName & vbCrLf _ 
     & "Please try again." 
    Exit Sub 
End If 
Close #intFileNum ' temporarily 

' Get the notes text 
Set oSlides = ActivePresentation.Slides 
For Each oSl In oSlides 
    For Each oSh In oSl.NotesPage.Shapes 
    If oSh.PlaceholderFormat.Type = ppPlaceholderBody Then 
     If oSh.HasTextFrame Then 
      If oSh.TextFrame.HasText Then 
       strNotesText = strNotesText & "Slide: " & CStr(oSl.SlideIndex) & vbCrLf _ 
       & oSh.TextFrame.TextRange.Text & vbCrLf & vbCrLf 
      End If 
     End If 
    End If 
    Next oSh 
Next oSl 

' now write the text to file 
Open strFileName For Output As intFileNum 
Print #intFileNum, strNotesText 
Close #intFileNum 

' show what we've done 
lngReturn = Shell("NOTEPAD.EXE " & strFileName, vbNormalFocus) 
End Sub 

它本質上導出所有幻燈片註釋從一個PowerPoint文件到一個文本文件中的幻燈片的時間順序。

無論如何改變代碼輸出到多個文本文件的幻燈片筆記？我的意思是，如果有4張幻燈片PowerPoint文檔中，我們可以按如下方式獲得的每張幻燈片的筆記導出：

• slide1notes.txt
• slide2notes.txt
• slide3notes.txt
• slide4notes.txt

非常感謝。

Answer 1

我沒有時間了大量的做多aircode這更多，但：

Sub TryThis() 
' Write each slide's notes to a text file 
' in same directory as presentation itself 
' Each file is named NNNN_Notes_Slide_xxx 
' where NNNN is the name of the presentation 
'  xxx is the slide number 

Dim oSl As Slide 
Dim oSh As Shape 
Dim strFileName As String 
Dim strNotesText As String 
Dim intFileNum As Integer 

' Get the notes text 
For Each oSl In ActivePresentation.Slides 
    For Each oSh In oSl.NotesPage.Shapes 
     If oSh.PlaceholderFormat.Type = ppPlaceholderBody Then 
      If oSh.HasTextFrame Then 
       If oSh.TextFrame.HasText Then 
        ' now write the text to file 
        strFileName = ActivePresentation.Path _ 
         & "\" & ActivePresentation.Name & "_Notes_" _ 
         & "Slide_" & CStr(oSl.SlideIndex) _ 
         & ".TXT" 
        intFileNum = FreeFile() 
        Open strFileName For Output As intFileNum 
        Print #intFileNum, oSh.TextFrame.TextRange.Text 
        Close #intFileNum 
       End If 
      End If 
     End If 
    Next oSh 
Next oSl 

End Sub 

Answer 2

而且，由於Mac的PPT/VBA是臭蟲出沒，這裏是爲Mac新版本。因爲我在做這在PC上，不能從Mac複製/粘貼到/，我沒有運行在Mac上的代碼，但它應該是確定：

Sub TryThis() 
' Write each slide's notes to a text file 
' in same directory as presentation itself 
' Each file is named NNNN_Notes_Slide_xxx 
' where NNNN is the name of the presentation 
'  xxx is the slide number 

Dim oSl As Slide 
Dim oSh As Shape 
Dim strFileName As String 
Dim strNotesText As String 
Dim intFileNum As Integer 

' Since Mac PPT will toss non-fatal errors, just keep moving along: 
On Error Resume Next 

' Get the notes text 
For Each oSl In ActivePresentation.Slides 
    For Each oSh In oSl.NotesPage.Shapes 

     ' Here's where the error will occur, if any: 
     If oSh.PlaceholderFormat.Type = ppPlaceholderBody Then 
     ' so deal with it if so: 
     If Err.Number = 0 Then 
      If oSh.HasTextFrame Then 
       If oSh.TextFrame.HasText Then 
        ' now write the text to file 
        strFileName = ActivePresentation.Path _ 
         & "\" & ActivePresentation.Name & "_Notes_" _ 
         & "Slide_" & CStr(oSl.SlideIndex) _ 
         & ".TXT" 
        intFileNum = FreeFile() 
        Open strFileName For Output As intFileNum 
        Print #intFileNum, oSh.TextFrame.TextRange.Text 
        Close #intFileNum 
       End If ' HasText 
      End If ' HasTextFrame 
     End If ' Err.Number = 0 
     End If ' PlaceholderType test 
    Next oSh 
Next oSl 

End Sub 

Answer 3

如果有人需要輸出在一個TXT文件中：

Sub TryThis() 
' Write each slide's notes to a text file 
' in same directory as presentation itself 
' Each file is named NNNN_Notes_Slide_xxx 
' where NNNN is the name of the presentation 
'  xxx is the slide number 

Dim oSl As Slide 
Dim oSh As Shape 
Dim strFileName As String 
Dim strNotesText As String 
Dim intFileNum As Integer 
Dim strLine As String 
Dim strData As String 

' Since Mac PPT will toss non-fatal errors, just keep moving along: 
On Error Resume Next 

' Get the notes text 
For Each oSl In ActivePresentation.Slides 
    For Each oSh In oSl.NotesPage.Shapes 

     ' Here's where the error will occur, if any: 
     If oSh.PlaceholderFormat.Type = ppPlaceholderBody Then 
     ' so deal with it if so: 
     If Err.Number = 0 Then 
      If oSh.HasTextFrame Then 
       If oSh.TextFrame.HasText Then 
        strData = strData + "Folie " & oSl.SlideIndex & vbCrLf & oSh.TextFrame.TextRange.Text & vbCrLf & vbCrLf 
        Close #intFileNum 
       End If ' HasText 
      End If ' HasTextFrame 
     End If ' Err.Number = 0 
     End If ' PlaceholderType test 
    Next oSh 
Next oSl 

' now write the text to file 
strFileName = ActivePresentation.Path _ 
& "\" & ActivePresentation.Name & "_Notes" _ 
& ".txt" 
intFileNum = FreeFile() 
Open strFileName For Output As intFileNum 
Print #intFileNum, strData 
Close #intFileNum 

End Sub