Consulting

Results 1 to 4 of 4

Thread: Excel VBA creating Word Document and Field codes

  1. #1
    VBAX Regular
    Joined
    Feb 2020
    Posts
    19
    Location

    Excel VBA creating Word Document and Field codes

    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....

    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

  2. #2
    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
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  3. #3
    VBAX Regular
    Joined
    Feb 2020
    Posts
    19
    Location
    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)

  4. #4
    There was a direction (0) missing off the last .Collapse.
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •