Office学习社区 › Office入门和提高 › ppt里的备注可以一次性删除吗？

tianjinliwei 发表于 2016-4-12 12:35:18

ppt里的备注可以一次性删除吗？

ppt里的备注可以一次性删除吗？

user_ybgkz 发表于 2016-4-12 13:42:58

Sub DeleteNote()
                    Dim actppt As Presentation
                    Dim pptcount As Integer
                    Dim iChose As Integer
                    Dim bDelete As Boolean
                    Dim sMsgBox As String
                    Dim dirpath As String
                    Dim txtstring As String
                                                   
                                                   
                    sMsgBox = "运行该宏之前，请先作好备份！继续吗？"
                    iChoice = MsgBox(sMsgBox, vbYesNo, "备份提醒")
                    If iChoice = vbNo Then
                        Exit Sub
                    End If
                                               
                    sMsgBox = "导出备注后，需要删除PPT备注吗？"
                    iChoice = MsgBox(sMsgBox, vbYesNo, "导出注释")
                    If iChoice = vbNo Then
                        bDelete = False
                    Else
                        bDelete = True
                    End If
                                                   
                                                   
                    Set actppt = Application.ActivePresentation
                    dirpath = actppt.Path & "" & actppt.Name & " 的备注.txt"
                    pptcount = actppt.Slides.Count
                                                   
                    '打开书写文件
                    Set fs = CreateObject("Scripting.FileSystemObject")
                    Set a = fs.CreateTextFile(dirpath, True)
                                                   
                    '遍历ppt
                    With actppt
                        For i = 1 To pptcount
                            txtstring = .Slides(i).NotesPage.Shapes.Placeholders(2).TextFrame.TextRange.Text
                            If (bDelete) Then
                                .Slides(i).NotesPage.Shapes.Placeholders(2).TextFrame.TextRange.Text = ""
                            End If
                                                           
                            a.writeline (.Slides(i).SlideIndex)
                            a.writeline (txtstring)
                            a.writeline ("")
                                                           
                        Next i
                    End With
                                                   
                    a.Close
                                                   
                End Sub
                                               

peggy121811 发表于 2016-4-12 13:53:11

不错
谢谢二楼的分享。

wangwangwu 发表于 2016-4-12 15:32:23

不错,VBA写得真好!

查看完整版本: ppt里的备注可以一次性删除吗？