home

-- Using MSWord (MicroSoft Word) to print from VB

Here is the downloadable version including word templates.
PrintToWord.zip

Option Explicit
Sub main()

    Select Case 1   ' change this to run different options
        Case 1
            option1         ' Uses table in template
        Case 2
            Option2         ' same as option1 but more flexible
        Case 3
            Option3         ' Creates table, uses range and sets more properties
    End Select
End Sub

Sub option1()
Dim objInvoice As New clsInvoice
Dim objInvoiceAmount
Dim iRow As Long
Dim iTotal As Currency
Dim iTotalVAT As Currency

' Add the word reference "microsoft word 9.0 object library" or similar
Dim objWord As Word.Application
' this would be faster with a "with objWord" but for clarity I use the explicit

    Set objWord = New Word.Application
    objWord.Visible = True
    objWord.Documents.Add App.Path & "\Invoice.dot", , , True
    objWord.ActiveDocument.Bookmarks("Invoice").Select
    iRow = 0
    iTotal = 0
    For Each objInvoiceAmount In objInvoice.colInvoice
        iRow = iRow + 1
        If iRow <> 1 Then
            objWord.Selection.InsertRowsBelow
        End If
        objWord.Selection.TypeText objInvoiceAmount.Description
        objWord.Selection.Cells(1).Next.Select
        objWord.Selection.TypeText "£ " & Format$(objInvoiceAmount.Amount, "#,###,##0.00")
        objWord.Selection.Cells(1).Next.Select
        objWord.Selection.TypeText "£ " & Format$(objInvoiceAmount.VAT, "#,###,##0.00")
        iTotal = iTotal + objInvoiceAmount.Amount
        iTotalVAT = iTotalVAT + objInvoiceAmount.VAT
    Next
    objWord.ActiveDocument.Bookmarks("Total").Select
    objWord.Selection.TypeText Format$(iTotal, "#,###,##0.00")
    objWord.Selection.Cells(1).Next.Select
    objWord.Selection.TypeText Format$(iTotalVAT, "#,###,##0.00")
    
    ' print the document
    objWord.ActiveDocument.PrintOut
    Do While objWord.BackgroundPrintingStatus > 0
    Loop
    objWord.Quit wdDoNotSaveChanges

End Sub

Sub Option2()
Dim objInvoice As New clsInvoice
Dim objInvoiceAmount
Dim iRow As Long
Dim iTotal As Currency
Dim iTotalVAT As Currency

' Add the word reference "microsoft word 9.0 object library" or similar
Dim objWord As Word.Application
Dim objBookmark As Word.Bookmark
    
    ' you would probably hold this in the invoice class
    ' must be pre-calculated as you can't predict the order of the bookmarks
    For Each objInvoiceAmount In objInvoice.colInvoice
        iTotal = iTotal + objInvoiceAmount.Amount
        iTotalVAT = iTotalVAT + objInvoiceAmount.VAT
    Next
    
    Set objWord = New Word.Application
    objWord.Visible = True
    objWord.Documents.Add App.Path & "\Invoice.dot", , , True
    
    For Each objBookmark In objWord.ActiveDocument.Bookmarks
        Select Case objBookmark.Name
            Case "Invoice"
                ' this would also be a subroutine with objWord and objBookmark as parameter.
                objBookmark.Select
                iRow = 0
                For Each objInvoiceAmount In objInvoice.colInvoice
                    iRow = iRow + 1
                    If iRow <> 1 Then
                        If iRow <> 1 Then
                            objWord.Selection.InsertRowsBelow
                        End If
                        objWord.Selection.TypeText objInvoiceAmount.Description
                        objWord.Selection.Cells(1).Next.Select
                        objWord.Selection.TypeText "£ " & Format$(objInvoiceAmount.Amount, "#,###,##0.00")
                        objWord.Selection.Cells(1).Next.Select
                        objWord.Selection.TypeText Format$(objInvoiceAmount.VAT, "#,###,##0.00")
                    End If
                Next
            Case "Total"
                objBookmark.Select
                objWord.Selection.TypeText Format$(iTotal, "#,###,##0.00")
                objWord.Selection.Cells(1).Next.Select
                objWord.Selection.TypeText Format$(iTotalVAT, "#,###,##0.00")
        End Select
    Next
    
    ' print the document
    objWord.ActiveDocument.PrintOut
    Do While objWord.BackgroundPrintingStatus > 0
    Loop
    objWord.Quit wdDoNotSaveChanges

End Sub
Sub Option3()
Dim objInvoice As New clsInvoice
Dim objInvoiceAmount
Dim iRow As Long
Dim iTotal As Currency
Dim iTotalVAT As Currency
' Add the word reference "microsoft word 9.0 object library" or similar
Dim objWord As Word.Application
Dim objDocument As Word.Document
Dim objTable As Word.Table

' this would be faster with a "with objWord" but for clarity I use the explicit

    Set objWord = New Word.Application
    objWord.Visible = True
    objWord.Documents.Add App.Path & "\Invoice2.dot", , , True
    Set objDocument = objWord.ActiveDocument
    
    Set objTable = objDocument.Tables.Add(objDocument.Bookmarks("Invoice").Range, 1, 3)
    'Set col widths
    objTable.Columns(1).Width = objWord.InchesToPoints(3)
    objTable.Columns(2).Width = objWord.InchesToPoints(1)
    objTable.Columns(3).Width = objWord.InchesToPoints(1)
    'headings
    objTable.Cell(1, 1).Range.Text = "Description"
    objTable.Cell(1, 1).Range.ParagraphFormat.Borders.OutsideLineStyle = wdLineStyleDouble
    objTable.Cell(1, 2).Range.Text = "Amount"
    objTable.Cell(1, 2).Range.ParagraphFormat.Alignment = wdAlignParagraphRight
    objTable.Cell(1, 2).Range.ParagraphFormat.Borders.OutsideLineStyle = wdLineStyleDouble
    objTable.Cell(1, 3).Range.Text = "VAT"
    objTable.Cell(1, 3).Range.ParagraphFormat.Alignment = wdAlignParagraphRight
    objTable.Cell(1, 3).Range.ParagraphFormat.Borders.OutsideLineStyle = wdLineStyleDouble
    
    
    ' data rows
    iRow = 1
    For Each objInvoiceAmount In objInvoice.colInvoice
        objTable.Rows.Add
        iRow = iRow + 1
        objTable.Cell(iRow, 1).Range.Text = objInvoiceAmount.Description
        objTable.Cell(iRow, 1).Range.ParagraphFormat.Borders.OutsideLineStyle = wdLineStyleNone

        objTable.Cell(iRow, 2).Range.Text = "£ " & Format$(objInvoiceAmount.Amount, "#,###,##0.00")
        objTable.Cell(iRow, 2).Range.ParagraphFormat.Alignment = wdAlignParagraphRight
        objTable.Cell(iRow, 2).Range.ParagraphFormat.Borders.OutsideLineStyle = wdLineStyleNone

        objTable.Cell(iRow, 3).Range.Text = "£ " & Format$(objInvoiceAmount.VAT, "#,###,##0.00")
        objTable.Cell(iRow, 3).Range.ParagraphFormat.Alignment = wdAlignParagraphRight
        objTable.Cell(iRow, 3).Range.ParagraphFormat.Borders.OutsideLineStyle = wdLineStyleNone

        iTotal = iTotal + objInvoiceAmount.Amount
        iTotalVAT = iTotalVAT + objInvoiceAmount.VAT
    Next

    ' Totals
    objTable.Rows.Add
    iRow = iRow + 1
    objTable.Cell(iRow, 1).Range.Text = "Totals"
    objTable.Cell(iRow, 1).Range.ParagraphFormat.Alignment = wdAlignParagraphRight
    objTable.Cell(iRow, 1).Range.ParagraphFormat.Borders.OutsideLineStyle = wdLineStyleDouble

    objTable.Cell(iRow, 2).Range.Text = "£ " & Format$(iTotal, "#,###,##0.00")
    objTable.Cell(iRow, 2).Range.ParagraphFormat.Alignment = wdAlignParagraphRight
    objTable.Cell(iRow, 2).Range.ParagraphFormat.Borders.OutsideLineStyle = wdLineStyleDouble

    objTable.Cell(iRow, 3).Range.Text = "£ " & Format$(iTotalVAT, "#,###,##0.00")
    objTable.Cell(iRow, 3).Range.ParagraphFormat.Alignment = wdAlignParagraphRight
    objTable.Cell(iRow, 3).Range.ParagraphFormat.Borders.OutsideLineStyle = wdLineStyleDouble
    
    ' print the document
    objWord.ActiveDocument.PrintOut
    Do While objWord.BackgroundPrintingStatus > 0
	' needs Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
	Sleep (250)     ' pause quarter second
    Loop
    objWord.Quit wdDoNotSaveChanges

End Sub

home