Home |
Search |
Today's Posts |
#1
|
|||
|
|||
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
|
|||
|
|||
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
|
|||
|
|||
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
|
|||
|
|||
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
|
|||
|
|||
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
|
|||
|
|||
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
|
|||
|
|||
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 |
Reply |
Thread Tools | |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Resources for Long Document Management | Microsoft Word Help | |||
Copying a Table Into a Table | Microsoft Word Help | |||
Table Issues | Microsoft Word Help | |||
In Word 2000, using the web wizard: How to remove table borders? | Microsoft Word Help | |||
Making a Form :: Line Borders / Table Cells with Flowing Text | Microsoft Word Help |