|
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 impression 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 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 impression 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 |