|
|
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
|
|
