Notizentext in Textfile speichern

Presentation, Slides, Shapes

Sub Save_NotesText_in_Textfile()

Dim ppPower As Presentation

Dim ppSlids As Slides

Dim ppSlide As Slide

Dim ppShaps As Shapes

Dim ppShape As Shape

Dim NotesText As String

Dim FileNum As Integer

Dim PathSep As String

#If Mac Then

PathSep = ":"

#Else

PathSep = "\"

#End If

Set ppPower = ActivePresentation

Set ppSlids = ppPower.Slides

For Each ppSlide In ppSlids

NotesText = NotesText & "Slide " & ppSlide.SlideIndex & vbCrLf

Set ppShaps = ppSlide.NotesPage.Shapes

For Each ppShape In ppShaps

If ppShape.HasTextFrame Then

If ppShape.TextFrame.HasText Then

NotesText = NotesText & ppShape.TextFrame.TextRange.Text

End If

Next ppShape

NotesText = NotesText & vbCrLf

Next ppSlide

FileNum = FreeFile

Open ppPower.Path & PathSep & "NotesText.TXT" For Output As FileNum

Print #FileNum, NotesText

Close FileNum

End Sub