Create Notes in Word

You probably know already that you can use "Send to Microsoft Word" to create your notes in Word. It's a little hidden in 2007 in Office Button > Publish but it's still there.

There are several options but none just type out your notes text in Word.

If this is what you need this code does just that. Opens Word and types in your notes from the active presentation!

Don't know how to use vba code

The code:

Sub Super_Typist()
Dim WdApp As Object
Dim WdDoc As Object
Dim osld As Slide
Dim oshp As Shape
Dim strNotes As String
Err.Clear
On Error Resume Next
Set WdApp = GetObject(Class:="Word.Application")
If Err <> 0 Then
Set WdApp = CreateObject("Word.Application")
End If

WdApp.Visible = True
Set WdDoc = WdApp.Documents.Add
For Each osld In ActivePresentation.Slides
For Each oshp In osld.NotesPage.Shapes
If oshp.Type = msoPlaceholder Then
If oshp.PlaceholderFormat.Type = ppPlaceholderBody Then
strNotes = oshp.TextFrame.TextRange
With WdApp.Selection
If strNotes <> "" Then
.Font.Bold = True
.Font.Size = .Font.Size + 10
.TypeText "Slide " & osld.SlideIndex & " Notes"
.TypeParagraph
.Font.Bold = False
.Font.Size = .Font.Size - 10
WdApp.Selection.TypeText (strNotes)
.TypeParagraph
End If
End With
End If
End If

Next oshp
Next osld

End Sub

If using Mac Office

Replace this line - If oshp.PlaceholderFormat.Type = ppPlaceholderBody Then

WITH

If oshp.Name Like "*Notes*" then

Don't Want to Touch Code at All?

Use as an AddIn with a proper menu. Download, unzip and run with PowerPoint CLOSED. A new menu will appear in 2002/3 and in 2007 it will be in the AddIns Tab. Note it only types out the notes.

Free download here but no support. NOT FOR MAC

Just ask the Super Typist to type out your notes and seconds later they are neatly typed out in Word with or without page breaks between slides.

 Requires versions XP - 2010

Outline and Notes

This version tries to type out both the outline and the notes for each slide Still under development!

Sub Outline_Notes_Word()
Dim WdApp As Object
Dim WdDoc As Object
Dim osld As Slide
Dim oshp As Shape
Dim strNotes As String
Dim strText As String
Err.Clear
On Error Resume Next
Set WdApp = GetObject(Class:="Word.Application")
If Err <> 0 Then
Set WdApp = CreateObject("Word.Application")
End If
WdApp.Visible = True
Set WdDoc = WdApp.Documents.Add
For Each osld In ActivePresentation.Slides
For Each oshp In osld.Shapes
If oshp.Type = msoPlaceholder Then
If oshp.PlaceholderFormat.Type < 10 Then
If oshp.HasTextFrame Then
If oshp.TextFrame.HasText Then
strText = strText & oshp.TextFrame.TextRange & vbCrLf
End If
End If
End If
End If
Next oshp
For Each oshp In osld.NotesPage.Shapes
If oshp.Type = msoPlaceholder Then
If oshp.PlaceholderFormat.Type = ppPlaceholderBody Then
strNotes = oshp.TextFrame.TextRange
With WdApp.Selection
.Font.Bold = True
.Font.Size = .Font.Size + 10
.typetext "Slide " & osld.SlideIndex
.typeparagraph
.Font.Bold = False
.Font.Size = .Font.Size - 10
.typetext (strText)
.typeparagraph
.Font.Bold = True
.typetext "NOTES"
.typeparagraph
.Font.Bold = False
If strNotes<>"" Then .typetext (strNotes) Else .typetext "No Notes"
.typeparagraph
End With
End If
End If
Next oshp
strText = ""
strNotes = ""
Next osld
End Sub

Multi Lingual (Selective Notes)

We were are asked if this could be adapted to print SELECTIVE parts of the notes page. In this particular case the user had multilingual notes formatted with html or xml type tags

<Eng> These are my English notes</Eng>

<Fr>Ce sont mes notes en français</Fr>

He wanted to be able to send just one set to Word

The Code:

Sub Selective_Notes_Word()
Dim strTag As String
Dim tagStart As Integer
Dim tagEnd As Integer
Dim WdApp As Object
Dim WdDoc As Object
Dim osld As Slide
Dim oshp As Shape
Dim strNotes As String
On Error Resume Next
strTag = InputBox("Insert Tag Name (Just the name NO '<') or '</>'")

Err.Clear
Set WdApp = GetObject(Class:="Word.Application")
If Err <> 0 Then ' make new App & Doc
Set WdApp = CreateObject("Word.Application")
Set WdDoc = WdApp.Documents.Add
End If

WdApp.Visible = True
Set WdDoc = WdApp.ActiveDocument
For Each osld In ActivePresentation.Slides
For Each oshp In osld.NotesPage.Shapes
If oshp.Type = msoPlaceholder Then
If oshp.PlaceholderFormat.Type = ppPlaceholderBody Then
strNotes = oshp.TextFrame.TextRange
tagStart = InStr(strNotes, "<" & strTag & ">")
If tagStart > 0 Then
tagStart = tagStart + 2 + Len(strTag)

tagEnd = InStr(strNotes, "</" & strTag & ">")
'strip out tagged section
strNotes = Mid$(strNotes, tagStart, (tagEnd - tagStart))
If strNotes <> "" Then
With WdApp.Selection
.Font.Size = 14
.Font.Bold = True
.Typetext "# " & osld.SlideIndex
.Font.Size=12
.Font.Bold = False
.TypeParagraph
.Typetext (strNotes)
.TypeParagraph
End With
End If
End If
End If
End If

Next oshp
Next osld

End Sub

No - I Want All the Comments!

Sub Comments_Word()
Dim WdApp As Object
Dim WdDoc As Object
Dim osld As Slide
Dim ocom As Comment
Dim strcomments As String
Err.Clear
On Error Resume Next
Set WdApp = GetObject(Class:="Word.Application")
If Err <> 0 Then
Set WdApp = CreateObject("Word.Application")
End If
WdApp.Visible = True
Set WdDoc = WdApp.Documents.Add
For Each osld In ActivePresentation.Slides
If osld.Comments.Count > 0 Then
For Each ocom In osld.Comments
strcomments = strcomments & ocom.AuthorInitials & " - " & ocom.Text & vbCrLf
Next ocom
With WdApp.Selection
.Font.Bold = True
.Font.Size = .Font.Size + 10
.typetext "Slide " & osld.SlideIndex & " Comments"
.typeparagraph
.Font.Bold = False
.Font.Size = .Font.Size - 10
WdApp.Selection.typetext (strcomments)
.typeparagraph
End With
End If 'comments
strcomments = ""
Next osld
Set WdApp = Nothing
Set WdDoc = Nothing
Set ocom = Nothing
Set oshp = Nothing
End Sub

All The Text - Text in Shapes etc

Sub Super_Typist3()
Dim WdApp As Object
Dim WdDoc As Object
Dim osld As Slide
Dim oshp As Shape
Dim strText As String
Err.Clear
On Error Resume Next
Set WdApp = GetObject(Class:="Word.Application")
If Err <> 0 Then
Set WdApp = CreateObject("Word.Application")
End If
WdApp.Visible = True
Set WdDoc = WdApp.Documents.Add
For Each osld In ActivePresentation.Slides
For Each oshp In osld.Shapes
If oshp.HasTextFrame Then
If oshp.TextFrame.HasText Then
strText = strText & "Shape: " & oshp.Name & " >>" & _
" Text: " & oshp.TextFrame.TextRange & vbCrLf
End If
End If
Next oshp
If strText <> "" Then
With WdApp.Selection
.Font.Bold = True
.Font.Size = .Font.Size + 10
.TypeText "Slide " & osld.SlideIndex & " Text"
.TypeParagraph
.Font.Bold = False
.Font.Size = .Font.Size - 10
.TypeText (strText)
.TypeParagraph
End With
End If
strText = ""
Next osld
End Sub

Back to the Index Page

POWERPOINT BLOG

Articles on your favourite sport

Free Microsoft PowerPoint Advice, help and tutorials, Template Links
This website is sponsored by Technology Trish Ltd
© Technology Trish 2007
Registered in England and Wales No.5780175
PowerPoint® is a registered trademark of the Microsoft Corporation