• Home
 · 
• VB function enhancement
 · 
• Format and Print a MSFlexGrid

Format and Print a MSFlexGrid

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.

Returns
Void

Side Effects
Grids with many columns (35 or more) could fullfill printers memory (low memory printers) causing the application to stop.

Rate Format and Print a MSFlexGrid

• 1
• 2
• 3
• 4
• 5

(5(5 Vote))

Sub 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