Category: VB function enhancement
Compatability: Visual Basic 3.0
Difficulty: Intermediate
Date Added: Wed 3rd February 2021
Rating: 
(4 Votes)
Format and Print a MSFlexGrid in a letter sheet, vertical or landscape, adding a Title, a logo, date and time of printing.
Inputs
MSFlexGrid to be printed
Title
Landscape (true/false)
Assumes
Works for letter size, suggestions welcome.
Code Returns
Void
Side Effects
Grids with many columns (35 or more) could fullfill printers memory (low memory printers) causing the application to stop.
VBcodersSub PrintGrid(pGrid As MSFlexGrid, sTitulo As String, pHorizontal As Boolean)
' pGrid = The grid to print
' sTitulo = Page Title
' pHorizontal = True for Landscape
On Error GoTo ErrorImpresion
Dim i As Integer
Dim iMaxRow As Integer
Dim j As Integer
Dim msfGrid As MSFlexGrid
Dim iPaginas As Integer
Printer.ColorMode = vbPRCMMonochrome
Printer.PrintQuality = 160
' fMainForm.MSFlexGrid1 is an invisible msflexgrid
' used only for this routine
' put it where your want and reference it apropiately
Set msfGrid = fMainForm.MSFlexGrid1
msfGrid.FixedCols = 0
msfGrid.Clear
If pHorizontal = True Then
Printer.Orientation = vbPRORLandscape
iMaxRow = 44
Else
Printer.Orientation = vbPRORPortrait
iMaxRow = 57
End If
' calcula el número de páginas
If pGrid.Rows Mod iMaxRow = 0 Then
iPaginas = pGrid.Rows \ iMaxRow
Else
iPaginas = pGrid.Rows \ iMaxRow + 1
End If
msfGrid.Rows = iMaxRow
msfGrid.Cols = pGrid.Cols
For i = 0 To pGrid.Cols - 1
msfGrid.ColWidth(i) = pGrid.ColWidth(i)
Next
screen.mousepointer = 11 ' hourglass
' print some logo -> comment or change as desired
Printer.PaintPicture fMainForm.ImageList1.ListImages(1).Picture, 0, 0, 4300, 600
' imprime título
Printer.CurrentY = 650
Printer.FontName = "Courier New"
Printer.FontBold = True
Printer.FontSize = 12
Printer.Print sTitulo
Printer.Print
' justifica a la derecha fecha de impresión
If pHorizontal = True Then
Printer.CurrentX = 10000
Else
Printer.CurrentX = 7000
End If
Printer.CurrentY = 0
Printer.FontSize = 10
Printer.Print Now & " - Pág 1 de " & iPaginas
For i = 0 To pGrid.Rows - 2 + iPaginas
If i Mod iMaxRow = 0 And i > 0 Then
With msfGrid
.Row = 0
.Col = 0
.ColSel = 0
.RowSel = 0
If pHorizontal Then
Printer.PaintPicture .Picture, 20, 1250, 15000, 10350
Else
Printer.PaintPicture .Picture, 20, 1250, 11400, 13950
End If
End With
Printer.NewPage
msfGrid.Clear
For j = 0 To msfGrid.Cols - 1
' restablece títulos
msfGrid.TextMatrix(0, j) = pGrid.TextMatrix(0, j)
Next
' print logo
Printer.PaintPicture fMainForm.ImageList1.ListImages(23).Picture, 0, 0, 4300, 600
Printer.CurrentY = 650
Printer.FontSize = 12
Printer.Print sTitulo
Printer.Print
' justifica a la derecha fecha de impresión
If pHorizontal = True Then
Printer.CurrentX = 10000
Else
Printer.CurrentX = 7000
End If
Printer.CurrentY = 0
Printer.FontSize = 10
Printer.Print Now & " - Pág " & i \ iMaxRow + 1 & " de " & iPaginas
i = i + 1 ' deja títulos
End If
For j = 0 To msfGrid.Cols - 1
msfGrid.TextMatrix(i Mod iMaxRow, j) = pGrid.TextMatrix(i - i \ iMaxRow, j)
Next
Next
With msfGrid
.Row = 0
.Col = 0
.ColSel = 0
.RowSel = 0
If pHorizontal Then
Printer.PaintPicture .Picture, 20, 1250, 15000, 10350
Else
Printer.PaintPicture .Picture, 20, 1250, 11400, 13950
End If
End With
Printer.EndDoc
MsgBox sTitulo & vbCrLf & "Se ha(n) enviado " & iPaginas & " página(s) a la impresora " & Printer.DeviceName, vbInformation, Printer.Port
salir:
Set msfGrid = Nothing
pubCursorDefault
Exit Sub
ErrorImpresion:
Printer.KillDoc
MsgBox "Verify printer", vbCritical, "Printer Error"
Resume salir
End Sub
