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

cbgege

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

tinnna

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

cxffxc

不错

谢谢二楼的分享。

tomlitomli

不错,VBA写得真好!