Excel VBA creating Word Document and Field codes

[MBACON]

Good Afternoon.

I have been working on a LIMS system based in excel and have nearly finish but one minor niggle.

(Note, before the suggestions come in,
No, creating a template with bookmarks and using that will not work (due to network security setting in place - they cannot/will not be change.)
No, creating the template as an embedded Object does not work either and the fidelity keeps getting lost.)

So userform is used to collect the data required, this then updates a log sheet before populating an excel sheet which is then copied and pasted into a new word document which is then automatically saved.

Titivation then takes place playing around with margins and adding standardised Header/Footer, This is where the problem arises....:banghead:

I am trying to put "Page 'X' of 'Y' " into the footer in column 2 of the table as marked in the code below [RED]. However, I cannot work out how to get the vbascript to add the field code in at this point. I have tried the code detailed below which causes the function to stop and kills any further running. If I leave this [With/End With] bit out then the report is generated but without the page numbers.

Help ??



Function FnWriteToWordDoc()

Set objWord = CreateObject("Word.Application")

Set objDoc = objWord.Documents.Add

Set objSelection = objWord.Selection

objWord.Visible = False ''


'######## Page Setup #############

With objSelection.PageSetup

.LineNumbering.Active = False
.Orientation = wdOrientPortrait
.TopMargin = CentimetersToPoints(2.27)
.BottomMargin = CentimetersToPoints(2.27)
.LeftMargin = CentimetersToPoints(1.27)
.RightMargin = CentimetersToPoints(1.27)
.Gutter = CentimetersToPoints(0)
.HeaderDistance = CentimetersToPoints(0.75)
.FooterDistance = CentimetersToPoints(0.75)
.PageWidth = CentimetersToPoints(21)
.PageHeight = CentimetersToPoints(29.7)
.FirstPageTray = wdPrinterDefaultBin
.OtherPagesTray = wdPrinterDefaultBin
.SectionStart = wdSectionNewPage
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.VerticalAlignment = wdAlignVerticalTop
.SuppressEndnotes = False
.MirrorMargins = False
.TwoPagesOnOne = False
.BookFoldPrinting = False
.BookFoldRevPrinting = False
.BookFoldPrintingSheets = 1
.GutterPos = wdGutterPosLeft

End With


With objSelection

.Paste '> Paste the Excel Data into Word

.InsertBreak Type:=wdPageBreak

.Font.Size = 14
.Font.Bold = True
.Font.Underline = wdUnderlineSingle
.TypeText Text:="Summary:"
.TypeParagraph
.Font.Size = 11
.Font.Bold = False
.Font.Underline = wdUnderlineNone
.TypeText Text:="xx:"
.TypeParagraph
.TypeParagraph

.Font.Size = 14
.Font.Bold = True
.Font.Underline = wdUnderlineSingle
.TypeText Text:="Report:"
.TypeParagraph
.Font.Size = 11
.Font.Bold = False
.Font.Underline = wdUnderlineNone
.TypeText Text:="xx:"
.TypeParagraph
.TypeParagraph
End With


Dim oTbl

'HEADER<<<<<<<<<
objDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables.Add _
Range:=objDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range, _
NumRows:=1, _
NumColumns:=3

Set oTbl = objDoc.Sections(1).Headers(1).Range.Tables(1)
With oTbl.Cell(1, 1).Range
.Font.Size = 16
.Font.Color = 192
.ParagraphFormat.Alignment = wdAlignParagraphLeft
.Text = "MATERIALS REVIEW"
End With

With oTbl.Cell(1, 2).Range
.Font.Size = 14
.ParagraphFormat.Alignment = wdAlignParagraphCenter
.Text = "Laboratory Report"
End With

With oTbl.Cell(1, 3).Range
.Font.Size = 14
.Font.Color = 192
.ParagraphFormat.Alignment = wdAlignParagraphRight
.Text = "Request: " & E_Req

End With

Set oTbl = Nothing

'FOOTER <<<<<<<<<
objDoc.Sections(1).Footers(wdHeaderFooterPrimary).Range.Tables.Add _
Range:=objDoc.Sections(1).Footers(wdHeaderFooterPrimary).Range, _
NumRows:=1, _
NumColumns:=3

Set oTbl = objDoc.Sections(1).Footers(1).Range.Tables(1)

With oTbl.Cell(1, 1).Range
.Font.Size = 11
.ParagraphFormat.Alignment = wdAlignParagraphLeft
.Text = "DO NOT COPY WITHOUT PERMISSION OF QUALITY MANAGER"
End With

With oTbl.Cell(1, 2).Range <<This 'WITH Section' is where the issue is.

.Fields.Add Range:=oTbl.Cell(1, 2).Range, _
Type:=wdFieldEmpty, _
Text:="NUMPAGES \* Arabic", _
PreserveFormatting:=True
End With


With oTbl.Cell(1, 3).Range
.Font.Size = 12
.Font.Color = 192
.ParagraphFormat.Alignment = wdAlignParagraphRight
.Text = "CONFIDENTIAL"
End With

Set oTbl = Nothing

'## Save Script
If REPRINT = True Then
objDoc.SaveAs (S_PATH & E_Req & "rp - " & E_DESC)

Else

objDoc.SaveAs (S_PATH & E_Req & " - " & E_DESC) 'Save the template with data in by RQ number and description in the Reports Path

End If

MsgBox ("Your Lab request has been raised." & vbCrLf & _
"to add any further information please open the word file " & vbCrLf & _
E_Req & " - " & E_DESC)

objWord.Visible = True


End Function

[gmayor]

Based on your code you want


Set oRng = oTbl.Cell(1, 2).Range
With oRng
.End = .End - 1
.Text = "Page "
oRng.Collapse 0
.Fields.Add Range:=oRng, _
Type:=wdFieldPage, _
Text:="\* Arabic"
.Collapse 0
.Text = " of "
.Collapse
.Fields.Add Range:=oRng, _
Type:=wdFieldNumPages, _
Text:="\* Arabic"
End With

[MBACON]

Thank you Graham,

Simple as that :) Works a charm!

Although interestingly, used as copied resulted in NumPages of PageNum in the created word document, presume it's something to do with the second collapse? so just switched the two field codes around)
:thumb

[gmayor]

There was a direction (0) missing off the last .Collapse.