VBA automating Word from PowerPoint

C

caten

I have an add-in macro that exports PPT content to a new Word document for
each PPT file in the same folder as the currently open PPT file. I've noticed
that when the macro is finished, and I go to Word, Word seems "paralyzed" (I
can't use any menu commands or close the doc). If I Alt+Tab back to
PowerPoint, and then Alt+Tab back to Word, all is well. Is there something
about automating Word from PowerPoint that needs to be "cleared" when the
PowerPoint macro ends - some way to release PowerPoint's control over Word?

I found http://www.pptfaq.com/FAQ00795.htm (and related items on
pptfaq.com), but don't see anything that specifically addresses terminating
control of one application from another. I also downloaded the Office
Automation Help from Microsoft and read about destroying an automation object
variable, but I'm not sure I have one (at least it doesn't look like the
example in the Help).

I'm using Office 2002 SP3.

Here's what I have so far:

Sub ExportTOCToWord()
Dim rayFileList() As String
Dim strFolderPath As String
Dim FileSpec
Dim strTemp As String
Dim X As Long
Dim oPres As Presentation 'used to define strFolderPath
Dim strFullTOC As String
Dim PathSep As String
Dim aTemp As Template
Dim MyDoc As New Word.Document
Dim strMyFile As String 'defines file name for SaveAs
Dim strTemplateFullName As String 'path to toc.dot template and filename
toc.dot

Set oPres = ActivePresentation
PathSep = "\"
strFolderPath = oPres.Path & PathSep
FileSpec = "*.ppt"

' Fill the array with files that meet the spec above
ReDim rayFileList(1 To 1) As String
strTemp = Dir$(strFolderPath & FileSpec)

While strTemp <> ""
rayFileList(UBound(rayFileList)) = strFolderPath & strTemp
ReDim Preserve rayFileList(1 To UBound(rayFileList) + 1) As String
strTemp = Dir
'Debug.Print strTemp
Wend

' array has one blank element at end - don't process it
' don't do anything if there's less than one element
If UBound(rayFileList) > 1 Then
For X = 1 To UBound(rayFileList) - 1
Call ForEachPPT(rayFileList(X))
'Debug.Print strTOC 'Prints full TOC WITH empty paragraphs between
modules
strFullTOC = strFullTOC & strTOC
'Debug.Print strFullTOC 'Prints full TOC WITHOUT empty paragraph
between modules
Next ' x
End If

'Define file name for Word doc and use same path as the active PPT
presentation
strMyFile = ActivePresentation.Path & "\toc.doc"
'Debug.Print strMyFile

On Error Resume Next

With MyDoc
.Application.Visible = False
.Application.ScreenUpdating = False
.ActiveWindow.View.Zoom.PageFit = wdPageFitFullPage
Set aTemp = .AttachedTemplate 'Get full name and path of default
template Normal.dot
strTemplateFullName = GetPath(aTemp.FullName) & "toc.dot"

'Create a Word doc based on the toc.dot template
Word.Documents.Add Template:=strTemplateFullName

Word.Application.Visible = True
Word.Application.ScreenUpdating = True
Word.ActiveDocument.SaveAs strMyFile

With Word.ActiveDocument
'Find the placeholder text "Paste TOC.txt here" and select it
With Selection.Find
.Forward = True
'ClearFormatting prevents applying whatever
'the most recent settings were in the Find and Replace
dialog box
.ClearFormatting
.MatchWholeWord = True
.Wrap = wdFindContinue
.Execute FindText:="Paste TOC.txt here"
End With
Selection.Text = strFullTOC
Selection.HomeKey Unit:=wdStory

'Reset style of last 3 paragraphs (one is the section break) to TOC 2
.Content.Paragraphs.Last.Range.Style = "TOC 2"
.Content.Paragraphs(.Content.Paragraphs.Count - 2).Range.Style =
"TOC 2"

End With 'ActiveDocument
Word.Documents("toc.doc").Save
MyDoc.Close
End With
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top