Group:  Microsoft Word ยป microsoft.public.word.vba.beginners
Thread: VB MS Word header

DotNetBag
.NET Development Newsgroups

HTVi
TV Discussion Newsgroups

Our Hot Pick: Rising Antivirus 2006 - Certified by TUV & Checkmark! Get 10% discount by entering this coupon code: ONDISCOUNT10
Rising Antivirus 2006

VB MS Word header
graham_s 06.02.2006 21:26:36
Hi,
I have copied some code that previously wrote to a Word doc page to write to
the page header. The code below is as far as I have got as there are some
problems.
1. The font.bold and font.size do not work
2. The copy and paste of the logo.bmp does not work
3. The tabstops are at different spacings compared to those when set on a
'normal' page
4. The line does not draw.

Can anyone help?
I would appreciate learning the best way to achieve this as my VBA word
knowledge is minimal (as evidenced by the code below!).

Thanks

Graham




////
code
Sub PrintStandardHeaderMSwordHeader(mobjWord As Object, RegisteredUser, _
Project, _
jobno, _
Subject, _
Calcby)


' Called from PrintCalcSheetHeader()


With mobjWord.ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range

..Paragraphs.tabstops.Add position:=370 ' 72 points/inch

If FileExists(App.Path & "\userlogo.bmp") Then
Clipboard.Clear
Clipboard.SetData LoadPicture(App.Path & "\userlogo.bmp") ' Get bitmap.
.Paste
.text = vbTab
Clipboard.Clear
Else
.font.Name = "arial"
.font.SIZE = 14
.font.Bold = True
.text = RegisteredUser & vbTab
End If

..font.SIZE = 11
..font.Bold = False
..insertafter "Vol. . . . . . "
..insertafter " Sec . . . . ." & vbCrLf

..insertafter "PROJECT : "
..insertafter Project & vbTab

..insertafter "Sheet . . . . . . of . . . . ." & vbCrLf
..insertafter "SUBJECT : "
..insertafter Subject & vbTab
..insertafter "Job No : "
..insertafter jobno & vbCrLf

..Paragraphs.tabstops(1).Clear
..Paragraphs.tabstops.Add position:=100
..Paragraphs.tabstops.Add position:=230
..Paragraphs.tabstops.Add position:=350

..insertafter "Calc by : "
..insertafter Calcby & vbTab
..insertafter "Date : "
..insertafter Format(Now, "dd-mmm-yy") & vbTab
..insertafter "Checked : " & vbTab
..insertafter "Date :" & vbCrLf

' draw a line under the header
..Paragraphs(1).tabstops.clearall
..Paragraphs.tabstops.Add position:=490
..font.underline = True
..insertafter vbTab
..font.underline = False
End With


End Sub
Re: VB MS Word header
Cindy M -WordMVP- <C.Meister-C[ at ]hispeed.ch> 08.02.2006 14:14:03
Hi =?Utf-8?B?Z3JhaGFtX3M=?=,

[Quoted Text]
> I have copied some code that previously wrote to a Word doc page to write to
> the page header. The code below is as far as I have got as there are some
> problems.
> 1. The font.bold and font.size do not work
>
Since we don't have sample values for the parameters, we can't really test, but
from looking through the code...

You start with an If-test, and in the Else part you apply formatting to the
Range. After the IF, you apply formatting again - to the SAME range. This will
override the formatting applied previously.

You should assign the range to a range variable:
dim rng as Word.Range
set rng =
ActiveDocument.Sections(1).PageSetup.Headers(wdHeaderFooterPrimariy).Range

Then use this in the code that follows. After the IF, in order to not lose what
you've done to the range, move the focus to the end of the range:
rng.Collapse wdCollapseEnd

Apply the formatting to a range AFTER you insert the text (unlike with the
Selection object).

> 2. The copy and paste of the logo.bmp does not work
>
Try using the InlineShapes.AddPicture method instead of copy/paste

> 3. The tabstops are at different spacings compared to those when set on a
> 'normal' page
>
Please provide more information (what you get vs what you expect)

> 4. The line does not draw.
>
The information on formatting and ranges may help, here

Cindy Meister
INTER-Solutions, Switzerland
http://homepage.swissonline.ch/cindymeister (last update Jun 8 2004)
http://www.word.mvps.org

This reply is posted in the Newsgroup; please post any follow question or reply
in the newsgroup and not by e-mail :-)

Re: VB MS Word header
graham_s 08.02.2006 21:29:27

Cindy,
Many thanks.
The code simply prints a facsimile engineering calculation sheet and the
input is generally strings except for the MS Word object, see comments in the
sub.

I found I had to use 'collapsestart' after the first format otherwise the
first text became the last.

I now only need to sort out the tabs. I cannot get them to work at all.
I want the first tab to be approx 75% of page width,

Sub PrintStandardHeaderMSwordHeader(mobjWord As Object, RegisteredUser, _
Project, _
jobno, _
Subject, _
Calcby)

'IN
' mobjWord = a MS word object, created as below
'Set mobjWord = CreateObject("Word.application")
'If Not mobjWord Is Nothing Then mobjWord.Visible = True
'Set mobjDoc = mobjWord.Documents.Add(App.Path & "\toolkit.dot")

'RegisteredUser =string for printing on output sheet
'Project =string
'jobno =string
'Subject =string
'Calcby =string


' Called from PrintCalcSheetHeader()


With mobjWord.ActiveDocument.Sections(1)
.Footers(wdHeaderFooterPrimary).PageNumbers.Add FirstPage:=True ',
Alignment:=wdAlignleft
End With


With mobjWord.ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range

If FileExists(App.Path & "\userlogo.bmp") Then
.InlineShapes.AddPicture Filename:=App.Path & "\userlogo.bmp"
.insertafter vbTab '(First tab space)
Else
.text = RegisteredUser & vbTab '(First tab space)
End If
..font.Name = "Arial"
..font.SIZE = 20
..Bold = True
'.Paragraphs.TabStops.Add position:=270 ' 72 points/inch 'FIRST TAB setting
..Collapse wdCollapseStart 'if I use wdCollapseEnd here, the text is moved to
the bottom of the header


..insertafter "Vol. . . . . . Sec . . . . ." & vbCrLf

..insertafter "PROJECT : " & Project & vbTab '(first tab space)

..insertafter "Sheet . . . . . . of . . . . ." & vbCrLf
..insertafter "SUBJECT : " & Subject & vbTab '(first tab space)
..insertafter "Job No : " & jobno & vbCrLf


..insertafter "Calc by : " & Calcby & vbTab '(2nd tab space)
..insertafter "Date : " & Format(Now, "dd-mmm-yy") & vbTab ' '(3rd tab space)
..insertafter "Checked : " & vbTab '(4th tab space)
..insertafter "Date :" & vbCrLf

'.Paragraphs.TabStops(1).Clear
'.Paragraphs.TabStops.Add position:=100 '2nd
'.Paragraphs.TabStops.Add position:=230 '3rd
'.Paragraphs.TabStops.Add position:=350 '4th

..font.SIZE = 11
..Bold = False
..Collapse wdCollapseStart

' draw a line under the header
..InlineShapes.AddHorizontalLineStandard


End With
End Sub




"Cindy M -WordMVP-" wrote:

[Quoted Text]
> Hi =?Utf-8?B?Z3JhaGFtX3M=?=,
>
> > I have copied some code that previously wrote to a Word doc page to write to
> > the page header. The code below is as far as I have got as there are some
> > problems.
> > 1. The font.bold and font.size do not work
> >
> Since we don't have sample values for the parameters, we can't really test, but
> from looking through the code...
>
> You start with an If-test, and in the Else part you apply formatting to the
> Range. After the IF, you apply formatting again - to the SAME range. This will
> override the formatting applied previously.
>
> You should assign the range to a range variable:
> dim rng as Word.Range
> set rng =
> ActiveDocument.Sections(1).PageSetup.Headers(wdHeaderFooterPrimariy).Range
>
> Then use this in the code that follows. After the IF, in order to not lose what
> you've done to the range, move the focus to the end of the range:
> rng.Collapse wdCollapseEnd
>
> Apply the formatting to a range AFTER you insert the text (unlike with the
> Selection object).
>
> > 2. The copy and paste of the logo.bmp does not work
> >
> Try using the InlineShapes.AddPicture method instead of copy/paste
>
> > 3. The tabstops are at different spacings compared to those when set on a
> > 'normal' page
> >
> Please provide more information (what you get vs what you expect)
>
> > 4. The line does not draw.
> >
> The information on formatting and ranges may help, here
>
> Cindy Meister
> INTER-Solutions, Switzerland
> http://homepage.swissonline.ch/cindymeister (last update Jun 8 2004)
> http://www.word.mvps.org
>
> This reply is posted in the Newsgroup; please post any follow question or reply
> in the newsgroup and not by e-mail :-)
>
>
Re: VB MS Word header
graham_s 11.02.2006 11:01:37
For the archives.
The final solution is below. No thanks to MS 'upside down' logic. ;-)


Sub PrintStandardHeaderMSwordHeader(mobjWord As Object, RegisteredUser, _
Project, _
jobno, _
Subject, _
Calcby)

'IN
' mobjWord = a MS word object, created as below
'Set mobjWord = CreateObject("Word.application")
'If Not mobjWord Is Nothing Then mobjWord.Visible = True
'Set mobjDoc = mobjWord.Documents.Add(App.Path & "\toolkit.dot")

'RegisteredUser =string for printing on output sheet
'Project =string
'jobno =string
'Subject =string
'Calcby =string


' Called from PrintCalcSheetHeader()


With mobjWord.ActiveDocument.Sections(1)
.Footers(wdHeaderFooterPrimary).PageNumbers.Add FirstPage:=True
End With


With mobjWord.ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range


.text = "" 'set a default font size otherwise get font 20 as last line
feed after the header "underline"

If FileExists(App.Path & "\userlogo.bmp") Then

.InlineShapes.AddPicture Filename:=App.Path & "\userlogo.bmp"
.InsertAfter vbTab

.font.Name = "Arial"
.font.SIZE = 8 'apply default font of 8
.Collapse wdCollapseStart

Else
.font.Name = "Arial"
.font.SIZE = 8
.Collapse wdCollapseStart

.InsertAfter RegisteredUser & vbTab
End If

'Apply formatting to above text (RegisteredUser)
.font.Name = "Arial"
.font.SIZE = 20
.Bold = True
.Paragraphs.TabStops.Add position:=375
.Collapse wdCollapseStart


.InsertAfter "Vol. . . . . . Sec . . . . ." & vbCrLf
.InsertAfter "PROJECT : " & Project & vbTab
.InsertAfter "Sheet . . . . . . of . . . . ." & vbCrLf
.InsertAfter "SUBJECT : " & Subject & vbTab
.InsertAfter "Job No : " & jobno & vbCrLf

'Apply formatting to text immediately above, (tabstop unchanged)
.font.SIZE = 11
.Bold = False
.Collapse wdCollapseStart


.InsertAfter "Calc by : " & Calcby & vbTab
.InsertAfter "Date : " & Format(Now, "dd-mmm-yy") & vbTab
.InsertAfter "Checked :. . . . . . . . ." & vbTab
.InsertAfter "Date :. . . . . . . . " & vbCrLf


' Apply (add) new tabstops to above and re-state text format (otherwise
the first size is applied)
.font.SIZE = 11
.Bold = False
.Paragraphs.TabStops.Add position:=120
.Paragraphs.TabStops.Add position:=230
.Collapse wdCollapseStart


' draw a line under the header
.font.SIZE = 8
.InsertAfter vbCrLf 'move line down a little
.InlineShapes.AddHorizontalLineStandard

.Collapse wdCollapseEnd


End With


End Sub

"graham_s" wrote:

[Quoted Text]
>
> Cindy,
> Many thanks.
> The code simply prints a facsimile engineering calculation sheet and the
> input is generally strings except for the MS Word object, see comments in the
> sub.
>
> I found I had to use 'collapsestart' after the first format otherwise the
> first text became the last.
>
> I now only need to sort out the tabs. I cannot get them to work at all.
> I want the first tab to be approx 75% of page width,
>
> Sub PrintStandardHeaderMSwordHeader(mobjWord As Object, RegisteredUser, _
> Project, _
> jobno, _
> Subject, _
> Calcby)
>
> 'IN
> ' mobjWord = a MS word object, created as below
> 'Set mobjWord = CreateObject("Word.application")
> 'If Not mobjWord Is Nothing Then mobjWord.Visible = True
> 'Set mobjDoc = mobjWord.Documents.Add(App.Path & "\toolkit.dot")
>
> 'RegisteredUser =string for printing on output sheet
> 'Project =string
> 'jobno =string
> 'Subject =string
> 'Calcby =string
>
>
> ' Called from PrintCalcSheetHeader()
>
>
> With mobjWord.ActiveDocument.Sections(1)
> .Footers(wdHeaderFooterPrimary).PageNumbers.Add FirstPage:=True ',
> Alignment:=wdAlignleft
> End With
>
>
> With mobjWord.ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range
>
> If FileExists(App.Path & "\userlogo.bmp") Then
> .InlineShapes.AddPicture Filename:=App.Path & "\userlogo.bmp"
> .insertafter vbTab '(First tab space)
> Else
> .text = RegisteredUser & vbTab '(First tab space)
> End If
> .font.Name = "Arial"
> .font.SIZE = 20
> .Bold = True
> '.Paragraphs.TabStops.Add position:=270 ' 72 points/inch 'FIRST TAB setting
> .Collapse wdCollapseStart 'if I use wdCollapseEnd here, the text is moved to
> the bottom of the header
>
>
> .insertafter "Vol. . . . . . Sec . . . . ." & vbCrLf
>
> .insertafter "PROJECT : " & Project & vbTab '(first tab space)
>
> .insertafter "Sheet . . . . . . of . . . . ." & vbCrLf
> .insertafter "SUBJECT : " & Subject & vbTab '(first tab space)
> .insertafter "Job No : " & jobno & vbCrLf
>
>
> .insertafter "Calc by : " & Calcby & vbTab '(2nd tab space)
> .insertafter "Date : " & Format(Now, "dd-mmm-yy") & vbTab ' '(3rd tab space)
> .insertafter "Checked : " & vbTab '(4th tab space)
> .insertafter "Date :" & vbCrLf
>
> '.Paragraphs.TabStops(1).Clear
> '.Paragraphs.TabStops.Add position:=100 '2nd
> '.Paragraphs.TabStops.Add position:=230 '3rd
> '.Paragraphs.TabStops.Add position:=350 '4th
>
> .font.SIZE = 11
> .Bold = False
> .Collapse wdCollapseStart
>
> ' draw a line under the header
> .InlineShapes.AddHorizontalLineStandard
>
>
> End With
> End Sub
>
>
>
>
> "Cindy M -WordMVP-" wrote:
>
> > Hi =?Utf-8?B?Z3JhaGFtX3M=?=,
> >
> > > I have copied some code that previously wrote to a Word doc page to write to
> > > the page header. The code below is as far as I have got as there are some
> > > problems.
> > > 1. The font.bold and font.size do not work
> > >
> > Since we don't have sample values for the parameters, we can't really test, but
> > from looking through the code...
> >
> > You start with an If-test, and in the Else part you apply formatting to the
> > Range. After the IF, you apply formatting again - to the SAME range. This will
> > override the formatting applied previously.
> >
> > You should assign the range to a range variable:
> > dim rng as Word.Range
> > set rng =
> > ActiveDocument.Sections(1).PageSetup.Headers(wdHeaderFooterPrimariy).Range
> >
> > Then use this in the code that follows. After the IF, in order to not lose what
> > you've done to the range, move the focus to the end of the range:
> > rng.Collapse wdCollapseEnd
> >
> > Apply the formatting to a range AFTER you insert the text (unlike with the
> > Selection object).
> >
> > > 2. The copy and paste of the logo.bmp does not work
> > >
> > Try using the InlineShapes.AddPicture method instead of copy/paste
> >
> > > 3. The tabstops are at different spacings compared to those when set on a
> > > 'normal' page
> > >
> > Please provide more information (what you get vs what you expect)
> >
> > > 4. The line does not draw.
> > >
> > The information on formatting and ranges may help, here
> >
> > Cindy Meister
> > INTER-Solutions, Switzerland
> > http://homepage.swissonline.ch/cindymeister (last update Jun 8 2004)
> > http://www.word.mvps.org
> >
> > This reply is posted in the Newsgroup; please post any follow question or reply
> > in the newsgroup and not by e-mail :-)
> >
> >

Home | Search | Terms | Imprint | Contact
Newsgroups Reader - provided by WiredBox.Net