Hi
I wrote a macro to create a table in a header in Word 97. Having upgraded to
2003, the borders all disappear when the document is printed.

The macro text is below (a lot of the text is irrelevant, but didn't want to
confuse by editing out bits). Does anyone have any suggestions for getting
the borders back?

Thanks

Public Sub Document_Open()
Dim DocTitle
Dim DocType
Dim DocRef
Dim DocRev
Dim DocIssuer
Dim DocDate
Dim oRange As Range
Dim pRange
Dim Currentfilename$
Dim DocStat$

DocTitle = System.PrivateProfileString("C:\WinNT\qwcs.ini", "Document",
"QWTitle")
DocType = System.PrivateProfileString("C:\WinNT\qwcs.ini", "Document",
"QWType")
DocRef = System.PrivateProfileString("C:\WinNT\qwcs.ini", "Document",
"QWRef")
DocRev = System.PrivateProfileString("C:\WinNT\qwcs.ini", "Document",
"QWRev")
DocIssuer = System.PrivateProfileString("C:\WinNT\qwcs.ini", "Document",
"QWOwner")
DocDate = System.PrivateProfileString("C:\WinNT\qwcs.ini", "Document",
"QWIssue")
DocNew$ = System.PrivateProfileString("c:\winNT\qwcs.ini", "Document",
"QWNew")
DocStat$ = System.PrivateProfileString("c:\winNT\qwcs.ini", "Document",
"QWStat")

Currentfilename$ = ActiveDocument.Name

If Left$(Currentfilename$, 1) = "~" Then

Select Case DocNew$

Case "FALSE"
Set rng = ActiveDocument.Range
rng.Font.Hidden = False

Set rng = ActiveDocument.Paragraphs(1).Range
rng.End = ActiveDocument.Paragraphs(2).Range.End
rng.Font.Hidden = True

End Select

Set rRange =
ActiveDocument.Sections(1).Headers(wdHeaderFooterP rimary).Range
With rRange
.Delete
End With
Set rRange =
ActiveDocument.Sections(1).Footers(wdHeaderFooterP rimary).Range
With rRange
.Delete
End With
Set myRange =
ActiveDocument.Sections(1).Headers(wdHeaderFooterP rimary).Range
With myRange.Font
.Name = "Arial"
'.Size = 11
.Bold = True
End With
Set oRng =
ActiveDocument.Sections(1).Headers(wdHeaderFooterP rimary).Range
With oRng
.Tables.Add oRng, 3, 3
.Font.Bold = True
With oRng.Tables(1)
.Columns(1).Width = InchesToPoints(3.6)
.Columns(2).Width = InchesToPoints(1.5)
.Columns(3).Width = InchesToPoints(1.3)
.Cell(Row:=2, Column:=1).Range.Text = vbCr & "Fisheries
Research Services" & vbCr & vbCr & "LABORATORY MANUAL"
.Cell(2, 1).Range.ParagraphFormat.Alignment =
wdAlignParagraphCenter
.Cell(3, 1).Range.Text = vbLf & DocTitle
.Cell(3, 1).Range.ParagraphFormat.Alignment =
wdAlignParagraphCenter
If DocStat$ = "ISSUED" Then
.Cell(2, 2).Range.Text = DocRef & vbLf & vbCr _
& "Issue No" & vbLf & vbCr & "Issued By" & vbLf &
vbCr & "Date of this Issue:"
ElseIf DocStat$ = "DRAFT" Then
.Cell(2, 2).Range.Text = DocRef & vbLf & vbCr _
& "Issue No" & vbLf & vbCr & "Issued By"
End If
.Cell(2, 2).Range.ParagraphFormat.Alignment =
wdAlignParagraphLeft
Set oRng =
ActiveDocument.Sections(1).Headers(wdHeaderFooterP rimary).Range.Tables(1).Ce
ll(1, 3).Range
oRng.Collapse
Set oBmk = ActiveDocument.Bookmarks.Add(Name:="zPos",
Range:=oRng)
Set oRng = oBmk.Range
strEntry = """Page X of Y"""
With oRng
.Fields.Add Range:=oBmk.Range,
Type:=wdFieldAutoText, Text:=strEntry
End With
If DocStat$ = "ISSUED" Then
.Cell(2, 3).Range.Text = vbCr & DocRev & vbCr & vbCr &
DocIssuer & vbCr & vbCr & DocDate
ElseIf DocStat$ = "DRAFT" Then
.Cell(2, 3).Range.Text = vbCr & DocRev & vbCr & vbCr &
DocIssuer & vbCr & vbCr & "Draft Version"
End If
.Cell(2, 3).Merge MergeTo:=.Cell(3, 3)
.Cell(1, 2).Merge MergeTo:=.Cell(2, 2)
.Cell(1, 2).Merge MergeTo:=.Cell(3, 2)
.Cell(1, 1).Merge MergeTo:=.Cell(2, 1)
End With

End With



Set myRange = ActiveDocument.Range
With myRange.Font
.Name = "Arial"
'.Size = 11
End With
Else


Set rRange = ActiveDocument.Sections(1).Headers(wdHeaderFooterP rimary).Range
With rRange
.Delete
End With

Set rng = ActiveDocument.Paragraphs(1).Range
rng.End = ActiveDocument.Paragraphs(2).Range.End
rng.Font.Hidden = False
rng.Font.Bold = True


End If

End Sub