Macro to fix header

[Chris Thompson]

Hello,

I am having a very odd issue that I am having a very difficult time trying to fix. Where I work, we are on a very limited budget, and cannot just purchase new software, so we have to do with what we have. That being said I will proceed with my issue.

We have a huge Oracle database. We use Crystal Reports to pull data from our database. Well, now some of our programmers have made forms in Crystal that queries the Oracle database, and then generates a Word document in a form that we submit to the courts. Well, the problem is, that the first page of our form has our logo, and then the second page (and subsequent pages)use a different header. Well, it seems that somewhere in the conversion from Crystal to Word, it makes it a difficult process to fix the second pageheader. I created a macro that fixes the second page. Here is the code Iuse:

___________________________________________
Sub FixHead()
'
' FixHead Macro
' Macro to correct the 2nd and subsequent page header in Report
'
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.MoveUp Unit:=wdLine, Count:=3
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
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
With ActiveDocument.Styles(wdStyleNormal).Font
If .NameFarEast = .NameAscii Then
.NameAscii = ""
End If
.NameFarEast = ""
End With
With ActiveDocument.PageSetup
.LineNumbering.Active = False
.Orientation = wdOrientPortrait
.TopMargin = InchesToPoints(0.5)
.BottomMargin = InchesToPoints(0.5)
.LeftMargin = InchesToPoints(0.75)
.RightMargin = InchesToPoints(0.75)
.Gutter = InchesToPoints(0)
.HeaderDistance = InchesToPoints(0.5)
.FooterDistance = InchesToPoints(0.5)
.PageWidth = InchesToPoints(8.5)
.PageHeight = InchesToPoints(11)
.FirstPageTray = wdPrinterDefaultBin
.OtherPagesTray = wdPrinterDefaultBin
.SectionStart = wdSectionNewPage
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = True
.VerticalAlignment = wdAlignVerticalTop
.SuppressEndnotes = True
.MirrorMargins = False
.TwoPagesOnOne = False
.BookFoldPrinting = False
.BookFoldRevPrinting = False
.BookFoldPrintingSheets = 1
.GutterPos = wdGutterPosLeft
End With
Selection.WholeStory
Selection.Copy
Selection.Copy
ActiveWindow.ActivePane.View.PreviousHeaderFooter
Selection.PasteAndFormat (wdPasteDefault)
ActiveWindow.ActivePane.View.NextHeaderFooter
Selection.WholeStory
Selection.TypeBackspace
Selection.Font.Name = "Times New Roman"
Selection.Font.Size = "12"
Selection.Font.Bold = wdToggle
Selection.TypeText Text:="LAST NAME, First MI" & vbTab & vbTab & vbTab & vbTab & vbTab & _
" "
Selection.TypeText Text:= _
" "
Selection.TypeText Text:=" PAGE "
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldPage
Selection.TypeParagraph
Selection.TypeText Text:="CASE NUMBER"
Selection.TypeParagraph
Selection.TypeText Text:="FILE NUMBER"
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
End Sub
_________________________________________________________

It seems if I just try to go to Page Setup and just check the Different First Page button, I lose the logo, and formatting on the document. But, alsothis code makes it necessary to have a lot of text in the document before it can be ran otherwise it deletes the logo. Also, it has to be run when the cursor is on the second page of the document as well.
What I want to do, is create a macro that can do essentially the same thing, but that doesn’t have the restrictions that this one has, and/or a button that can be placed on the toolbar, or hover, that a user can just click to fix the headers problem.

Is there any better solution that I can do?

Note: We use Office XP, on Win XP SP3, and Crystal Reports XI.