A Microsoft Office (Excel, Word) forum. OfficeFrustration

If this is your first visit, be sure to check out the FAQ by clicking the link above. You may have to register before you can post: click the register link above to proceed. To start viewing messages, select the forum that you want to visit from the selection below.

Go Back   Home » OfficeFrustration forum » Microsoft Word » Page Layout
Site Map Home Register Authors List Search Today's Posts Mark Forums Read  

macroed table - borders missing



 
 
Thread Tools Display Modes
  #1  
Old January 10th, 2005, 05:30 PM
Gavin Grear
external usenet poster
 
Posts: n/a
Default macroed table - borders missing

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




  #2  
Old January 10th, 2005, 06:59 PM
Suzanne S. Barnhill
external usenet poster
 
Posts: n/a
Default

May I ask why you're using a macro instead of just creating a template that
already has the table in the header?

--
Suzanne S. Barnhill
Microsoft MVP (Word)
Words into Type
Fairhope, Alabama USA
Word MVP FAQ site: http://word.mvps.org
Email cannot be acknowledged; please post all follow-ups to the newsgroup so
all may benefit.

"Gavin Grear" wrote in message
...
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





  #3  
Old January 11th, 2005, 11:54 AM
Gavin Grear
external usenet poster
 
Posts: n/a
Default

Hi Suzanne
The documents are being opened through a document control software package,
which contains 1000+ documents. The information which populates the header
is called by the macro from the software. At the time of commissioning, we
were advised to use a macro to create the header, that way we could more
easily control any changes to the format. Whether that's correct or not,
we're stuck with it, as all the documents are linked to the macro, and can
only be changed by a rather convoluted process through the software. I'm
afraid I'm just after a quick fix this time round!
Thanks

"Suzanne S. Barnhill" wrote in message
...
May I ask why you're using a macro instead of just creating a template

that
already has the table in the header?

--
Suzanne S. Barnhill
Microsoft MVP (Word)
Words into Type
Fairhope, Alabama USA
Word MVP FAQ site: http://word.mvps.org
Email cannot be acknowledged; please post all follow-ups to the newsgroup

so
all may benefit.

"Gavin Grear" wrote in message
...
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







  #4  
Old January 11th, 2005, 12:25 PM
Jezebel
external usenet poster
 
Posts: n/a
Default

In that case, modify the macro to apply borders to your table. Seems
stunningly irresponsible to have 1000+ documents based on such a
conspicuously incompetent bit of macro coding. With so much at stake you're
likely to be better off -- even in the short term -- biting the bullet and
applying a good solution rather than trying to patch up a bad one.



"Gavin Grear" wrote in message
...
Hi Suzanne
The documents are being opened through a document control software

package,
which contains 1000+ documents. The information which populates the header
is called by the macro from the software. At the time of commissioning, we
were advised to use a macro to create the header, that way we could more
easily control any changes to the format. Whether that's correct or not,
we're stuck with it, as all the documents are linked to the macro, and can
only be changed by a rather convoluted process through the software. I'm
afraid I'm just after a quick fix this time round!
Thanks

"Suzanne S. Barnhill" wrote in message
...
May I ask why you're using a macro instead of just creating a template

that
already has the table in the header?

--
Suzanne S. Barnhill
Microsoft MVP (Word)
Words into Type
Fairhope, Alabama USA
Word MVP FAQ site: http://word.mvps.org
Email cannot be acknowledged; please post all follow-ups to the

newsgroup
so
all may benefit.

"Gavin Grear" wrote in message
...
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









  #5  
Old January 11th, 2005, 01:28 PM
Gavin Grear
external usenet poster
 
Posts: n/a
Default

Point taken, hindsight is a wonderful thing. Irony is the code was provided
by one of the MS newsgroup folk, so there you go!

Can anyone provide the lines of code so the borders appear, to at least help
us inthe short term - these documents are being printed out daily, so I
really do need the quick fix at the moment!

Thanks

"Jezebel" wrote in message
...
In that case, modify the macro to apply borders to your table. Seems
stunningly irresponsible to have 1000+ documents based on such a
conspicuously incompetent bit of macro coding. With so much at stake

you're
likely to be better off -- even in the short term -- biting the bullet and
applying a good solution rather than trying to patch up a bad one.



"Gavin Grear" wrote in message
...
Hi Suzanne
The documents are being opened through a document control software

package,
which contains 1000+ documents. The information which populates the

header
is called by the macro from the software. At the time of commissioning,

we
were advised to use a macro to create the header, that way we could more
easily control any changes to the format. Whether that's correct or not,
we're stuck with it, as all the documents are linked to the macro, and

can
only be changed by a rather convoluted process through the software. I'm
afraid I'm just after a quick fix this time round!
Thanks

"Suzanne S. Barnhill" wrote in message
...
May I ask why you're using a macro instead of just creating a template

that
already has the table in the header?

--
Suzanne S. Barnhill
Microsoft MVP (Word)
Words into Type
Fairhope, Alabama USA
Word MVP FAQ site: http://word.mvps.org
Email cannot be acknowledged; please post all follow-ups to the

newsgroup
so
all may benefit.

"Gavin Grear" wrote in message
...
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











  #6  
Old January 11th, 2005, 02:04 PM
Jezebel
external usenet poster
 
Posts: n/a
Default

Don't go blaming the person who supplied the code ... someone at your end
made the decision to use it....

But anyway ... find this bit of your macro ..

.Cell(1, 1).Merge MergeTo:=.Cell(2, 1)
End With

and change it to include ...

.Cell(1, 1).Merge MergeTo:=.Cell(2, 1)

With .Borders(wdBorderBottom)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth050pt
.Color = wdColorAutomatic
End With

With .Borders(wdBorderTop)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth050pt
.Color = wdColorAutomatic
End With

With .Borders(wdBorderLeft)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth050pt
.Color = wdColorAutomatic
End With

With .Borders(wdBorderRight)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth050pt
.Color = wdColorAutomatic
End With

End With


I'm assuming you just want standard width, plain line, black borders on all
four sides of each cell. Change the arguments as needed if you want
something else.



"Gavin Grear" wrote in message
...
Point taken, hindsight is a wonderful thing. Irony is the code was

provided
by one of the MS newsgroup folk, so there you go!

Can anyone provide the lines of code so the borders appear, to at least

help
us inthe short term - these documents are being printed out daily, so I
really do need the quick fix at the moment!

Thanks

"Jezebel" wrote in message
...
In that case, modify the macro to apply borders to your table. Seems
stunningly irresponsible to have 1000+ documents based on such a
conspicuously incompetent bit of macro coding. With so much at stake

you're
likely to be better off -- even in the short term -- biting the bullet

and
applying a good solution rather than trying to patch up a bad one.



"Gavin Grear" wrote in message
...
Hi Suzanne
The documents are being opened through a document control software

package,
which contains 1000+ documents. The information which populates the

header
is called by the macro from the software. At the time of

commissioning,
we
were advised to use a macro to create the header, that way we could

more
easily control any changes to the format. Whether that's correct or

not,
we're stuck with it, as all the documents are linked to the macro, and

can
only be changed by a rather convoluted process through the software.

I'm
afraid I'm just after a quick fix this time round!
Thanks

"Suzanne S. Barnhill" wrote in message
...
May I ask why you're using a macro instead of just creating a

template
that
already has the table in the header?

--
Suzanne S. Barnhill
Microsoft MVP (Word)
Words into Type
Fairhope, Alabama USA
Word MVP FAQ site: http://word.mvps.org
Email cannot be acknowledged; please post all follow-ups to the

newsgroup
so
all may benefit.

"Gavin Grear" wrote in message
...
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













  #7  
Old January 11th, 2005, 03:03 PM
Gavin Grear
external usenet poster
 
Posts: n/a
Default

Hi Jezebel
Making decisions from an ignorant point of view is always going to be dodgy
I guess! )
The code worked fine, many thanks.
For when we look to moving over to templates - is this the right newsgroup?
Cheers


"Jezebel" wrote in message
...
Don't go blaming the person who supplied the code ... someone at your end
made the decision to use it....

But anyway ... find this bit of your macro ..

.Cell(1, 1).Merge MergeTo:=.Cell(2, 1)
End With

and change it to include ...

.Cell(1, 1).Merge MergeTo:=.Cell(2, 1)

With .Borders(wdBorderBottom)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth050pt
.Color = wdColorAutomatic
End With

With .Borders(wdBorderTop)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth050pt
.Color = wdColorAutomatic
End With

With .Borders(wdBorderLeft)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth050pt
.Color = wdColorAutomatic
End With

With .Borders(wdBorderRight)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth050pt
.Color = wdColorAutomatic
End With

End With


I'm assuming you just want standard width, plain line, black borders on

all
four sides of each cell. Change the arguments as needed if you want
something else.



"Gavin Grear" wrote in message
...
Point taken, hindsight is a wonderful thing. Irony is the code was

provided
by one of the MS newsgroup folk, so there you go!

Can anyone provide the lines of code so the borders appear, to at least

help
us inthe short term - these documents are being printed out daily, so I
really do need the quick fix at the moment!

Thanks

"Jezebel" wrote in message
...
In that case, modify the macro to apply borders to your table. Seems
stunningly irresponsible to have 1000+ documents based on such a
conspicuously incompetent bit of macro coding. With so much at stake

you're
likely to be better off -- even in the short term -- biting the bullet

and
applying a good solution rather than trying to patch up a bad one.



"Gavin Grear" wrote in message
...
Hi Suzanne
The documents are being opened through a document control software
package,
which contains 1000+ documents. The information which populates the

header
is called by the macro from the software. At the time of

commissioning,
we
were advised to use a macro to create the header, that way we could

more
easily control any changes to the format. Whether that's correct or

not,
we're stuck with it, as all the documents are linked to the macro,

and
can
only be changed by a rather convoluted process through the software.

I'm
afraid I'm just after a quick fix this time round!
Thanks

"Suzanne S. Barnhill" wrote in message
...
May I ask why you're using a macro instead of just creating a

template
that
already has the table in the header?

--
Suzanne S. Barnhill
Microsoft MVP (Word)
Words into Type
Fairhope, Alabama USA
Word MVP FAQ site: http://word.mvps.org
Email cannot be acknowledged; please post all follow-ups to the
newsgroup
so
all may benefit.

"Gavin Grear" wrote in message
...
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















 




Thread Tools
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

vB code is On
Smilies are On
[IMG] code is Off
HTML code is Off
Forum Jump

Similar Threads
Thread Thread Starter Forum Replies Last Post
Making a Form :: Line Borders / Table Cells with Flowing Text John General Discussion 1 January 2nd, 2005 03:42 PM
Update - If statement Dan @BCBS Running & Setting Up Queries 13 December 14th, 2004 07:02 PM
Manual line break spaces on TOC or Table of tables Eric Page Layout 9 October 29th, 2004 04:42 PM
Semicolon delimited text query help Al Guerra Running & Setting Up Queries 3 August 12th, 2004 11:50 AM
Page break and table bottom borders. Jacek Krolikowski Tables 2 April 27th, 2004 03:28 PM


All times are GMT +1. The time now is 03:09 PM.


Powered by vBulletin® Version 3.6.4
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 OfficeFrustration.
The comments are property of their posters.