Help with first macro please

[Brian]

I have written my first macro. It works well on all but a few documents. All
it does is copies the text , headers and footers etc from a template document
(that people though would be carried across simply by assigning the template)
to the document.

It always fall over at the same point in 2 large documents that I can see no
difference in layout .

Any advice would be appreciated.

The code is as follows, I have added a comment on the line "falls over
here".Roughly half way down.

It probably isn't the best written macro, but it is my first attempt.

Sub format()
'
' format Macro
' Macro created 27/09/2006 by mccaffery
'
'This macro has two functions. Firstly, it will appply all missing template
details.
'It will then remove the extra spaces form the index tags in hidden text.
'
'Check to see if any other docs are open
'
If Windows.Count >= 2 Then
MsgBox "Please close all other Word Documents", vbOKOnly +
vbInformation, "Stop"
If Response <> vbOK Then
Exit Sub
End If
End If
'
'Go to top of document
'
Selection.HomeKey Unit:=wdStory
'
' Now open the template doc
'
ChDir ActiveDocument.AttachedTemplate.Path
Documents.Open FileName:="robo_manual_2006b_RHT.dot", _
ConfirmConversions:=False, ReadOnly:=False, _
AddToRecentFiles:=False, _
format:=wdOpenFormatAuto, XMLTransform:=""
'
'Copy front matter
'
With Selection
.MoveDown Unit:=wdParagraph, Count:=15, Extend:=wdExtend
.Copy
End With
'
'Activate document window
'
Windows(1).Activate
'
'Paste front matter into document
'
With Selection
.PasteAndFormat (wdPasteDefault)
.MoveRight Unit:=wdCharacter, Count:=24, Extend:=wdExtend
.Delete Unit:=wdCharacter, Count:=1
End With
If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
ActiveWindow.Panes(2).Close
End If
'
'Prepare document view for pasting footers
'
If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
ActivePane.View.Type = wdOutlineView Then
ActiveWindow.ActivePane.View.Type = wdPrintView
End If
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
If Selection.HeaderFooter.IsHeader = True Then
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
Else
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
End If
'
'activate template document
'
ActiveWindow.ActivePane.View.NextHeaderFooter
Windows(2).Activate
Application.WindowState = wdWindowStateMaximize
If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
ActiveWindow.Panes(2).Close
End If
If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
ActivePane.View.Type = wdOutlineView Then
ActiveWindow.ActivePane.View.Type = wdPrintView
End If
'
'find first footer occurrence
'
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
If Selection.HeaderFooter.IsHeader = True Then
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
Else
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
End If
ActiveWindow.ActivePane.View.NextHeaderFooter
'
'copy footer details
'
With Selection
.MoveRight Unit:=wdWord, Count:=2, Extend:=wdExtend
.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
.Copy
End With
'
'activate document window
'
Windows(1).Activate
'
'paste toc footer using loop as we don't know how many pages in toc
'
Do
With Selection
.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
.PasteAndFormat (wdPasteDefault)
.TypeBackspace
End With
Exit Do
Loop Until SectionBreakOddPage = True
'
'paste footer info into first/odd/even etc
'
Windows(1).Activate
Do While counter < 5
With ActiveDocument
ActiveWindow.ActivePane.View.NextHeaderFooter (falls over here)
With Selection
.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
.PasteAndFormat (wdPasteDefault)
.TypeBackspace
End With
End With
counter = counter + 1
If counter = 4 Then
Exit Do
End If
Loop
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
'
'activate template doc
'
Windows(2).Activate
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
'
'find and copy back matter
'
With Selection
.EndKey Unit:=wdStory
.MoveUp Unit:=wdLine, Count:=1
.MoveUp Unit:=wdParagraph, Count:=9, Extend:=wdExtend
.MoveUp Unit:=wdLine, Count:=18, Extend:=wdExtend
.Copy
End With
'
'activate document window
'
Windows(1).Activate
'
'paste back matter
'
With Selection
.EndKey Unit:=wdStory
.Style = ActiveDocument.Styles("Body Text")
.InsertBreak Type:=wdSectionBreakEvenPage
.Style = ActiveDocument.Styles("BackPage")
.PasteAndFormat (wdPasteDefault)
End With
'
'close template doc
'
Windows(2).Close
'
'select all and update fields
'
With Selection
.WholeStory
.Fields.Update
.HomeKey Unit:=wdStory
End With
'
'
' search and replace index size problem
'
' View hidden text
'
Application.DisplayStatusBar = True
Application.ShowWindowsInTaskbar = True
Application.ShowStartupDialog = False
With ActiveWindow
With .View
.ShowHiddenText = True
End With
End With
'
' Find and replace
'
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = " "" \*"
.Replacement.Text = """ \*"
.Forward = True
.Wrap = wdFindContinue
.format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute replace:=wdReplaceAll
'
' reset hidden text view
'
Application.DisplayStatusBar = True
Application.ShowWindowsInTaskbar = True
Application.ShowStartupDialog = False
With ActiveWindow
With .View
.ShowHiddenText = False
End With
End With
End Sub

 

[Doug Robbins - Word MVP]

You should save the "template documents" as templates in your users Work
Group Templates Folder and then get your users to use File>New and then
select the template that they want to use.

Then you won't need any macros.

--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

 

[Brian]

Sorry, I didn't describe the problem fully. I am using the Macro on Word
output from RoboHelp. We attach the template when we generate the printed
output, but it doesn't pick up all text and fields in the template Document.
This is a known problem in the RoboHelp community.