Vba 如何将powerpoint幻灯片笔记导出到单个文本文件？

通过一些研究，我在以下网站上发现了此VBA代码：

Sub ExportNotesText（）
将奥斯陆变暗为幻灯片
将oSl变暗为幻灯片
暗淡的oSh形状
Dim strNotesText作为字符串
将strFileName设置为字符串
Dim intFileNum作为整数
暗变长
'获取文件名以存储收集的文本
strFileName=InputBox（“输入要将注释文本提取到的文件的完整路径和名称”，“输出文件？”）
'用户取消了吗？
如果strFileName=“”，则
出口接头
如果结束
'路径有效吗？粗糙但有效的测试：尝试创建文件。
intFileNum=FreeFile（）
出错时继续下一步
打开strFileName以作为intFileNum输出
如果错误号为0，则“我们有问题”
MsgBox“无法创建文件：”&strFileName&vbCrLf_
&“请再试一次。”
出口接头
如果结束
暂时关闭#intFileNum
'获取注释文本
设置oSlides=ActivePresentation.Slides
对于奥斯陆的每个oSl
对于oSl.NotesPage.Shapes中的每个oSh
如果oSh.PlaceholderFormat.Type=ppPlaceholderBody，则
如果是oSh.HasTextFrame，则
如果是oSh.TextFrame.HasText，则
strNotesText=strNotesText和“幻灯片：&CStr（oSl.SlideIndex）&vbCrLf_
&oSh.TextFrame.TextRange.Text&vbCrLf&vbCrLf
如果结束
如果结束
如果结束
下一个职业安全与健康
下一个奥斯陆
'现在将文本写入文件
打开strFileName以作为intFileNum输出
打印#intFileNum，strNotesText
关闭#intFileNum
“展示我们所做的一切
lngReturn=Shell（“NOTEPAD.EXE”和strFileName，vbNormalFocus）
端接头

它基本上是将Powerpoint文件中的所有幻灯片笔记按幻灯片的时间顺序导出到一个文本文件中

是否需要修改代码以将幻灯片注释输出到多个文本文件中？我的意思是，如果powerpoint文档中有4张幻灯片，我们将得到每个幻灯片的注释导出，如下所示：

• slide1notes.txt
• slide2notes.txt
• slide3notes.txt
• slide4notes.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

' 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

---

由于Mac PPT/VBA存在大量的bug，下面是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

---

如果任何人需要一个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

---

谢谢你，史蒂夫……不幸的是，它不太管用。获取的错误为：“运行时错误”-2147483640（80000008）”：占位符格式（未知成员）：失败。“按“调试”将突出显示此行：如果oSh.PlaceholderFormat.Type=ppPlaceholderBody，则我已更正代码中的一个错误。。添加了intFileNum=FreeFile（）。。。但除此之外，它在这里工作得很好。您正在哪个版本的PowerPoint中运行此操作？这可能是您看到的错误的原因。我正在Mac上运行最新的Powerpoint 2011，但仍然收到相同的错误。也许可以解释一下我在做什么：打开PPT文件>工具>宏>Visual Basic编辑器>插入>模块>在新窗口中粘贴代码>运行>上面的错误消息。我做错什么了吗？“我做错什么了吗？”使用Mac PowerPoint.；-）我可以在这里重新解释这个问题。这似乎是Mac实现中的一个bug；更多的测试表明，当它到达notes页面上的幻灯片编号占位符时失败。因此，在获取文本之前，请确保Err.Number=0

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