Visual Basic Programming Code Examples

Visual Basic > Other Code Examples

Print the contents of an MS FlexGrid



Print the contents of an MS FlexGrid

Unfortunately the MSFlexGrid control doesn't have built in print functionality. However, the following code demostrates a simple technique for overcoming this limitation:

'Purpose     :  Sends the contents of the Microsoft's MSFlexgrid control to the default printer.
'Inputs      :  fgPrint                 The flexgrid to print
'               [lOrientation]          The paper orientation (either vbPRORPortrait or vbPRORLandscape)
'               [lMaxRowsPerPage]       The maximum number of rows to print on a page, if -1 then determines
'                                       this number based on the paper size.
'               [lTopBorder]            The paper's top border.
'               [lLeftBorder]           The paper's left border.
'               [lRowsToRepeat]         The number of rows to repeat at the top of each page (i.e. the number of heading rows).
'Outputs     :  Returns True if the grid was successfully printed.
'Notes       :  The ScaleMode property of object determines the unit of measure used for the paper borders.
'Revisions   :

Function FlexGridPrint(fgPrint As MSFlexGrid, Optional lOrientation As Long = vbPRORPortrait, Optional ByVal lMaxRowsPerPage As Long = -1, Optional lTopBorder As Long = 1000, Optional lLeftBorder As Long = 1000, Optional lRowsToRepeat As Long = 0) As Boolean
    Dim lRowsPrinted As Long, lRowsPerPage As Long
    Dim lThisRow As Long, lNumRows As Long, lImageHeight As Long, lLastImageTop As Long
    Dim lPrinterPageHeight As Long, lPagesPrinted As Long, lHeadingHeight As Long
    
    On Error GoTo ErrFailed
    fgPrint.TopRow = 1
    lNumRows = fgPrint.Rows - 1
    lPrinterPageHeight = Printer.Height
    lRowsPerPage = lMaxRowsPerPage
    lRowsPrinted = lRowsToRepeat

    If lRowsToRepeat Then
        'Calculate the height of the heading row
        For lThisRow = 1 To lRowsToRepeat
            lHeadingHeight = lHeadingHeight + fgPrint.RowHeight(lThisRow)
        Next
    End If

    Do
        'Calculate the number of rows for this page
        lImageHeight = 0
        lRowsPerPage = 0
        'Setup printer
        Printer.Orientation = lOrientation

        For lThisRow = lRowsPrinted To lNumRows
            lImageHeight = lImageHeight + fgPrint.RowHeight(lThisRow)
            If lRowsPerPage > lMaxRowsPerPage And lMaxRowsPerPage <> -1 Then
                'Image has required number of rows, subtract height of current row
                lImageHeight = lImageHeight - fgPrint.RowHeight(lThisRow)
                Exit For
            ElseIf lImageHeight + lTopBorder * 2 + lHeadingHeight > lPrinterPageHeight Then           'Allow the same border at the bottom and top
                'Image is larger than page, subtract height of current row
                lImageHeight = lImageHeight - fgPrint.RowHeight(lThisRow)
                Exit For
            End If
            lRowsPerPage = lRowsPerPage + 1
        Next
        
        'Print this page
        lPagesPrinted = lPagesPrinted + 1
        If lRowsToRepeat Then
            'Print heading rows
            Printer.PaintPicture fgPrint.Picture, lLeftBorder, lTopBorder, , lHeadingHeight, , 0, , lHeadingHeight
            'Print data rows
            Printer.PaintPicture fgPrint.Picture, lLeftBorder, lTopBorder + lHeadingHeight, , lImageHeight + lHeadingHeight, , lLastImageTop + lHeadingHeight, , lImageHeight + lHeadingHeight
        Else
            'Print data rows
            Printer.PaintPicture fgPrint.Picture, lLeftBorder, lTopBorder, , lImageHeight, , lLastImageTop, , lImageHeight
        End If
        
        Printer.EndDoc
        
        'Store printer position
        lRowsPrinted = lRowsPrinted + lRowsPerPage
        lLastImageTop = lLastImageTop + lImageHeight + lHeadingHeight
    
    Loop While lRowsPrinted < lNumRows
    
    FlexGridPrint = True
    
    Exit Function
    
ErrFailed:
    'Failed to print grid
    FlexGridPrint = False
    Debug.Print "Error in FlexGridPrint: " & Err.Description
End Function


'TEST CODE
'Load the grid with demo data
Private Sub Form_Load()
    Dim lThisRow  As Long
    MSFlexGrid1.Rows = 0
    
    MSFlexGrid1.AddItem "Name" & vbTab & "Age"
    For lThisRow = 1 To 150
        MSFlexGrid1.AddItem "Red is ace " & lThisRow & vbTab & 20 + lThisRow
    Next
    MSFlexGrid1.FixedRows = 1
End Sub

Private Sub MSFlexGrid1_DblClick()
    'Print the grid with the top row as a title row
    FlexGridPrint Me.MSFlexGrid1, , , , , 1
End Sub