Issue with Word 2003 VBA Macro in Word 2007

[TeeBeeOz]

Hello

Firstly, apologies upfront for being a VBA dummy!

Issue:

We have successfully used a macro I believe was originally created using Word 98 VBA in Word 2003. After migrating to MS Office 2007, the same macro no longer 100% works, ie it just fails on the last part of the process.

Simply, the macro copies text seleted by the user into the Page 2+ header section of our letter documents. Part of this involves inserting a page break (to access the 2+ header section), copying the selected text into the header and then removing the page break inserted earlier in the macro .... it is the last part of the process that no longer works, ie so the user is left with a page break (and an unwanted page) at the end of their letter. Here's the code:

Selection.Copy
Selection.EndKey Unit:=wdStory
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.InsertBreak Type:=wdPageBreak

If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
ActiveWindow.Panes(2).Close
End If
If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
ActivePane.View.Type = wdOutlineView Or ActiveWindow.ActivePane.View.Type _
= wdMasterView Then
ActiveWindow.ActivePane.View.Type = wdPageView
End If
' get into the header for this page (2+) and paste the text - no
' formatting hence paste special. This text is pasted at LHS - assumes
' other required information has been put in the header
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.PasteSpecial Link:=False, DataType:=wdPasteText, Placement:= _
wdInLine, DisplayAsIcon:=False
' back to main document and remove additional hard page
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
Selection.TypeBackspace

I've tried re-creating the macro from scratch in Word 2007, but still can't get it to work properly. Any assistance would be greatly appreciated ... :yes

[macropod]

Hi TeeBeeOz,

Your entire macro could be reduced to:
Sub Demo()
With Selection
.Range.Cut
.Sections.First.Headers(wdHeaderFooterPrimary).Range.Paste
End With
End Sub
Simply change the name to whatever you're currently using and replace the existing code. Also, Change 'Cut' to 'Copy' if you merely want the selection replicated in the header.

[TeeBeeOz]

Hello Macropod

Thank you for such a prompt reply - and I'm very impressed by the much reduced code.

It works really well ... and I can now create our legal templates using .dotx (instead of downsaving to .dot) - wonderful!

Thanks again ... :bow:

[macropod]

Hi TeeBeeOz,

That suggests you document doesn't have a 'Different first page' layout - which may be behind the problems with your original code. In which case, try:
Sub Demo()
With Selection
.Range.Cut
With .Sections.First
.PageSetup.DifferentFirstPageHeaderFooter = True
.Headers(wdHeaderFooterPrimary).Range.Paste
End With
End With
End Sub

[TeeBeeOz]

Hi Macropod

Sorry - I realised that and amended my reply but obviously too late (ie you received my first response) ... sorry.

Just one thing - the code doesn't accommodate the other formatting components of our 2+ page header (ie page number, date and line) - please refer attached with how our header needs to look and how it looks with the new code. Are you able to suggest how these other formatting components can also be retained (ie they are already set-up in our templates to generate in the header automatically)?

Sorry to be a pain ... :doh:

[macropod]

Hi TeeBeeOz,

Accomodating that and the possibility that the 'different first page' setup may or may not have been defined adds complexity:
Sub Demo()
With Selection
.Range.Cut
With .Sections.First
If .PageSetup.DifferentFirstPageHeaderFooter = False Then
.PageSetup.DifferentFirstPageHeaderFooter = True
.Headers(wdHeaderFooterFirstPage).Range = .Headers(wdHeaderFooterPrimary).Range
End If
With .Headers(wdHeaderFooterPrimary).Range
.Collapse wdCollapseStart
.Paste
End With
End With
End With
End Sub

[TeeBeeOz]

Hi Macropod!

That did it - just beautiful!

Thank you so much - so quick and efficient (great we are in the same country!).

Thanks again ...:bow: :bow: :bow:

[TeeBeeOz]

Psst Macropod ... can I push the friendship just a little more?

What would I need to add after the following code so that it will delete the last character highlighted?

With Selection
.Range.Cut

(Using our original macro, the user highlights the whole line (which selects the paragraph return too) and the original script would then exclude the paragraph return via "Selection.MoveLeft Unit:=wdCharacter, Count:=1". Can this be done with your script?)

Thanks so much ... :)

[macropod]

Hi TeeBeeOz,

Between the two lines you posted, insert a new line with:
If .Characters.Last.Text = vbCr Then .End = .End - 1
That's all you should need. If you want, you can add tests for tabs, spaces, etc. in the same way.

[TeeBeeOz]

You are a guru!! Thank you so much ... :bow: :bow: :bow: :bow: