Macro not working correctly

[Rich]

Hi I have a macro which is designed to transfer PPT to Word (Office 2003).
The macro works fine on my computer, but does not work on the computer of a
colleague. She is also running Office 2003.
The macro starts and gives the message
Sub send_to_MS_Word()
The macro stops and gives the message.
Dim appWD As Word.Application 'declaring variables
Any thoughts (Shyam??)

 

[Rich]

Steve, This is the one you helped me with at PPT Live last year in SanDiego.
Here's the code.
Sub send_to_MS_Word()


Dim appWD As Word.Application 'declaring variables
Dim counter As Long
Dim i As Integer
Dim text As String
Dim temp As String

On Error GoTo ErrorHandler

'' Set appWD = New Word.Application 'creating new MS Word
document
'' appWD.Documents.Add

counter = ActivePresentation.Slides.Count 'counting slides


'specify slide size using dialogbox
Value = InputBox("Enter prefered size - an integer value within the
range 1 to 199, otherwise 100% will be used", "Choose slide size", 100)
If (Value > 0 And Value < 200) Then
size = Value
Else
size = 100
End If

'specify notes fontsize using dialogbox
Value = InputBox("Enter prefered notes fontsize - an integer value
within the range 1 to 19, otherwise 10 will be used", "Choose notes
fontsize", 12)
If (Value > 0 And Value < 20) Then
fontsize = Value
Else
fontsize = 12
End If

Set appWD = New Word.Application 'creating new MS Word document
appWD.Documents.Add

appWD.Documents(appWD.Documents.Count).Activate ' activate most
recently created MS Word document

appWD.ActiveDocument.Range.Select ' select an area within the
document

For i = 1 To counter Step 1 ' for each slide do

ActivePresentation.Slides(i).Copy ' copy single slide

appWD.Selection.Paste ' and paste it to MS Word
document

appWD.ActiveDocument.InlineShapes(i).ScaleHeight = size ' change
the slide size
appWD.ActiveDocument.InlineShapes(i).ScaleWidth = size

appWD.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
' center slide

appWD.Selection.TypeParagraph ' insert new line
appWD.Selection.TypeParagraph ' insert new line


ActivePresentation.Slides(i).NotesPage.Shapes.Placeholders(2).TextFrame.TextRange.Copy ' copy notes

appWD.Selection.Paste ' and paste it under the slide


appWD.Selection.InsertBreak Type:=wdPageBreak ' insert new page

Next i



appWD.Selection.TypeBackspace ' delete last page (which is empty)

appWD.ActiveDocument.PageSetup.OddAndEvenPagesHeaderFooter = True





'-----------------------------------------------------------------------------

'odd Pages
'headers
On Error Resume Next
text =
ActivePresentation.Slides(2).NotesPage.Master.Shapes(4).TextFrame.TextRange.text
If Err.Number <> 0 Then
MsgBox "Problem locating header or other notes master text." _
& vbCrLf _
& "Please make sure notes page headers and footers are in proper
order."
End If


With appWD.ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary)
.Range.InsertAfter (text)
.Range.Paragraphs(1).Alignment = wdAlignParagraphRight
End With

'Footers
appWD.ActiveWindow.ActivePane.View.SeekView = wdSeekPrimaryFooter
text =
ActivePresentation.Slides(2).NotesPage.Master.Shapes(5).TextFrame.TextRange.text
appWD.Selection.TypeText (text)
appWD.Selection.TypeText text:=vbTab
ActivePresentation.Slides(2).NotesPage.Master.Shapes(6).Copy
appWD.Selection.Paste
appWD.Selection.MoveRight Unit:=wdCharacter, Count:=1
appWD.Selection.TypeText text:=vbTab
text =
ActivePresentation.Slides(2).NotesPage.Master.Shapes(3).TextFrame.TextRange.text
text = Left(text, 2) + ": "
appWD.Selection.TypeText (text)
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldPage
appWD.Selection.TypeText text:=" of "
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldNumPages
appWD.Selection.Delete Unit:=wdCharacter, Count:=1




'even Pages
'Headers
text =
ActivePresentation.Slides(2).NotesPage.Master.Shapes(4).TextFrame.TextRange.text

With appWD.ActiveDocument.Sections(1).Headers(wdHeaderFooterEvenPages)
.Range.InsertAfter (text)
.Range.Paragraphs(1).Alignment = wdAlignParagraphLeft
End With

'footers
appWD.ActiveWindow.ActivePane.View.SeekView = wdSeekEvenPagesFooter



appWD.Selection.MoveLeft Unit:=wdCharacter, Count:=1
text =
ActivePresentation.Slides(2).NotesPage.Master.Shapes(3).TextFrame.TextRange.text
text = Left(text, 2) + ": "
appWD.Selection.TypeText (text)
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldPage
appWD.Selection.TypeText text:=" of "
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldNumPages

appWD.Selection.TypeText text:=vbTab
ActivePresentation.Slides(2).NotesPage.Master.Shapes(6).Copy
appWD.Selection.Paste
appWD.Selection.MoveRight Unit:=wdCharacter, Count:=1
appWD.Selection.TypeText text:=vbTab
text =
ActivePresentation.Slides(2).NotesPage.Master.Shapes(5).TextFrame.TextRange.text
appWD.Selection.TypeText (text)
appWD.Selection.Delete Unit:=wdCharacter, Count:=1


'-------------------------------------------------------------------------------
appWD.ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument

appWD.Selection.WholeStory ' select whole content

appWD.Selection.Font.size = fontsize ' change notes fontsize

appWD.ActiveDocument.Range(0, 0).Select

appWD.Visible = True ' show MS Word window
appWD.Quit
Set appWD = Nothing

' Application.Quit 'line responsible for closing
PowerPoint, NECESSARY to fix Office bug

NormalExit:
Exit Sub

ErrorHandler:
MsgBox "Error; please check presentation and try again"
Resume Next

End Sub

Basically the macro stops at
Dim appWD As Word.Application 'declaring variables
Which is the second line. The macro can't find Word??

 

[Shyam Pillai]

Rich,
Either set a reference to the Word library or

make changes to the code
- replace each word constant with it's relevant constant value
e.g. Repalce wdCharacter with 1
- Declare variables accordingly:
Dim appWD As Object 'Word.Application
' more code here...
Set appWD = CreateObject("Word.Application")

 

[Rich]

Shyam When are you gonna publish VBA for PPT hmmmmm?? There IS a need.

 

[Rich]

Still waiting :>)
--
Rich

Shyam When are you gonna publish VBA for PPT hmmmmm?? There IS a need.

 

[Rich]

sorry so late. Still waiting for SHYAM's book. Please don't keep us in
suspense..We'll even PAY for it!