VB and VBA Users Source Code: Print the contents of an MS FlexGrid
[
Home
|
Contents
|
Search
|
Reply
| Previous |
Next
]
VB/VBA Source Code
Print the contents of an MS FlexGrid
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Monday, March 12, 2001
Hits:
4126
Category:
Database/SQL/ADO
Article:
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. 'Author : Andrew Baker 'Date : 03/09/2001 13:58 '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 "Andrew 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
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
