VB MS Word header

G

graham_s

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
 
C

Cindy M -WordMVP-

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
Click to expand...
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
Click to expand...
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
Click to expand...
Please provide more information (what you get vs what you expect)
4. The line does not draw.
Click to expand...
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 :)
 
G

graham_s

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
 
G

graham_s

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
 
Top