Ale, venga, que nadie se va a mojar el culo.
Me parece que a nadie le gusta imprimir, porque nadie contesta este tipo
de mails, ¿qué narices haceis con los datos? ¿coleccionarlos?, si vais
entrando pero nunca los sacais...
Este código es para aquellos que estamos intentando imprimir, si le
encontrais fallos (que no dudo que tenga, aunque a mi me vaya bien)
decidmelos y ya puestos me los podrías hasta corregir, puestos a pedir
:-)
Eduardo de la Torre y Antonie E. López, decidme que tal os va y los
problemas que encontrais y lo dicho si los podeis corregir...
Pasos a seguir para imprimir un grid
-------------------------------------
1. Crear un grid y meterlo en el Form1, metiendole (por ejemplo) 6 filas
y columnas.
2. Añadir el siguinete código al evento Form1 Click:
Sub Form_Click ()
Dim i, j
For i = 0 To Grid1.Cols - 1
For j = 0 To Grid1.Rows - 1
Grid1.Col = i
Grid1.Row = j
Grid1.Text = Format$(i + j + i ^ j)
Next
Next
Call Grid_Print(Grid1)
Printer.EndDoc
End Sub
2. Añadir el siguiente código a la sección de declaraciones globales:
Sub Grid_Print (grid As Control)
Dim tppx As Integer
Dim tppy As Integer
tppx = Printer.TwipsPerPixelX
tppy = Printer.TwipsPerPixelY
Dim Col As Integer
Dim Row As Integer
Dim x0 As Single
Dim y0 As Single
Dim x1 As Single
Dim y1 As Single
Dim x2 As Single
Dim y2 As Single
x0 = Printer.CurrentX
y0 = Printer.CurrentY
If grid.BorderStyle <> 0 Then
Printer.Line -Step(grid.Width - tppx, grid.Height - tppy), , B
x0 = x0 + tppx
y0 = y0 + tppy
End If
x1 = x0
For Col = 0 To grid.Cols - 1
If Col >= grid.FixedCols And Col < grid.LeftCol Then
Col = grid.LeftCol
End If
If x1 + grid.ColWidth(Col) >= grid.Width Then Exit For
y1 = y0
For Row = 0 To grid.Rows - 1
If Row >= grid.FixedRows And Row < grid.TopRow Then
Row = grid.TopRow
End If
If y1 + grid.RowHeight(Row) >= grid.Height Then Exit For
Printer.CurrentX = x1 + tppx * 2
Printer.CurrentY = y1 + tppy
grid.Col = Col
grid.Row = Row
Printer.Print grid.Text
y1 = y1 + grid.RowHeight(Row)
If grid.GridLines Then
y1 = y1 + tppy
End If
Next
x1 = x1 + grid.ColWidth(Col)
If grid.GridLines Then
x1 = x1 + tppx
End If
Next
If grid.GridLines Then
x2 = x0
y2 = y0
For Col = 0 To grid.Cols - 1
If Col >= grid.FixedCols And Col < grid.LeftCol Then
Col = grid.LeftCol
End If
x2 = x2 + grid.ColWidth(Col)
If x2 >= grid.Width Then Exit For
Printer.Line (x2, y0)-Step(0, y1 - tppy)
x2 = x2 + tppx
Next
For Row = 0 To grid.Rows - 1
If Row >= grid.FixedRows And Row < grid.TopRow Then
Row = grid.TopRow
End If
y2 = y2 + grid.RowHeight(Row)
If y2 >= grid.Height Then Exit For
Printer.Line (x0, y2)-Step(x1 - tppx, 0)
y2 = y2 + tppy
Next
End If
End Sub
3. Ejecutarlo
-------------------
Hèctor Agea Merino
Barcelona - Espanna
agea@hotmail.com
-------------------
X-Mailreader: GoldED/386 2.51.A1026+
Sender: llander@pobox.com (Guillermo Llanderas)
X-UIDL: fa419af7b8024d54ec1df36a19655b4d
¡Hola, Jose!
Aquí tienes las rutinas. :)
> ---------8<---------8<--------- CORTAR ---------8<---------8<---------
Option Explicit ' - Ian Patton, 1994-96 - ipatton@indigo.ie
'Here is a simple routine I have devised which for me
'simplifies the printing of the contents of a TruegGrid to the
'printer. There are also two Grid Copy routines: one for the
'standard VB Grid control and one for TrueGrid. They are all
'independent of column or row numbers so should work straight off.
'These routines were dsigned and used in VB 3. They may work in
'VB 4 but I have'nt tried them yet.
'The copy routines produce Tab Separated text which can then be
'pasted into any word processor and formatted as required. proper
'alignment of columns in your word processor may require a change
'of font or the addition of some Tabs to help balance a column.
'The print routine formats text as it finds it in TrueGrid, ie:
'Left/Centre/Right aligned as appropriate. I have had to set the
'print body text to Courier so that Right Alignment would work
'properly. Proportionally spaced fonts like Arial & Times produce
'a ragged right margin. If anyone knows how to overcome this, I
'would welcome your advice.
'You are FREE to use the enclosed as is, or to modify it to suit
'your needs as required. It is Free. All I would ask is that:
' (a) You do not re-submit the enclosed on any bullitin board,
' or through any internet service provider as your own work
' or, if included as part of a larger submission, you leave
' the copyright/eMail flag at the start of each routine.
' (b) If you use this in your own programs, again leave the
' copyright/eMail flag at the start of each routine, just
' to remember me !
' (c) Any chance of giving me feedback, just to say if you
' found it any use (or not!) and if so, were you able
' to use any of it
'Any comments, criticisms etc would be welcome. Choose which form
'of adress best suits you, from below. Good luc :-)
'Compuserve: 100024,1606
'Internet: ipatton@indigo.ie
'Usual disclaimer. The enclosed works for me but I can't guarantee
'that it will work for You. Use at your own risk. By accepting and
'using the enclosed, you agree that I have no responsibility for
'any loss, direct or consequential, as a result of your use.
'Ian Patton
Sub Copy_Grid () ' - Ian Patton, 1994-96 - ipatton@indigo.ie
'Generic sub for clipboard copy from standard GRID.VBX
Dim CopyText As String, NC As String, NR As String
Dim First_Col As Integer, First_Row As Integer
'GridName = your grid. replace as required
Screen.MousePointer = 11
Clipboard.Clear 'not really necessary (but safe)
NC = Chr$(9) 'Tab Character
NR = Chr$(13) & Chr$(10) 'Carriage Return & Linefeed
First_Col = GridName.Fixedcols 'Set counter for first column
First_Row = GridName.FixedRows 'Set counter for first row
For i% = First_Row To GridName.Rows - 1
GridName.Row = i%
For j% = 0 + First_Col To GridName.Cols - 1
GridName.Col = j%
If j% = First_Col Then
CopyText = CopyText & GridName.text
Else
CopyText = CopyText & NC & GridName.text
End If
Next
CopyText = CopyText & NR
Next
Clipboard.SetText CopyText
Screen.MousePointer = 0
End Sub
Sub Copy_TrueGrid () ' - Ian Patton, 1994-96 - ipatton@indigo.ie
'Generic sub for clipboard copy from TrueGrid
Dim CopyText, TC, CRL As String, r As Integer, c As integr
Dim First_Col, First_Row As Integer
'MyTrueGrid = your grid. replace as required
Screen.MousePointer = 11 'show Hourglass, copy could take a while
MyTrueGrid.Active = False 'Stop TrueGrid "flashing"
Clipboard.Clear 'not really necessary (but safe)
CopyText = ""
TC = Chr$(9) 'Tab character
CRL = Chr$(13) & Chr$(10) 'Carriage Return & Linefeed
First_Col = 1 'Set counter for first column
First_Row = 1 'Set counter for first row
MyTrueGrid.TopRow = 1 'Position to first row
MyTrueGrid.LeftColumn = 1 'Position to first column
For r = First_Row To RowCount
MyTrueGrid.RowIndex = r
For c = First_Col To RateTable.Columns - 1
MyTrueGrid.ColumnIndex = c
If MyTrueGrid.ColumnVisible(c) = True Then
If c = First_Col Then
CopyText = CopyText & MyTrueGrid.text
Else
CopyText = CopyText & TC & MyTrueGrid.text
End If
End If
Next
CopyText = CopyText & CRL
Next
Clipboard.SetText CopyText 'Send copied table to clipboard
Screen.MousePointer = 0 'Return cursor to default
MyTrueGrid.RowIndex = 1 'Re-position to first column
MyTrueGrid.ColumnIndex = 1 'Re-Position to first column
MyTrueGrid.Active = True 'Reinstate TrueGrid
End Sub
Sub Print_MyTrueGrid () ' - Ian Patton, 1994-96 - ipatton@indigo.ie
'Generic print sub for MyTrueGrid tables
Dim ColStyle, ColWide, TabNow, TabPos, LineCount As Integer
Dim RptName, RptSub, ColText, PageFoot As String
Dim r As Integer, n As Integer, c As Integer
'MyTrueGrid = your grid. replace as required
Screen.MousePointer = 11 'show Hourglass, print could take a while
Printer.ScaleMode = 4 'characters
'Assign text to String Variables
RptName = "Anything Title you like" 'can be a variable if preferred
RptSub = "Anything Subtitle you like" 'can be a variable if preferred
PageFoot = "Page: "
LineCount = 0
'Set display and position to 1st row / 1st column
MyTrueGrid.TopRow = 1: MyTrueGrid.RowIndex = 1
MyTrueGrid.LeftColumn = 1: MyTrueGrid.ColumnIndex = 1
For r = 1 To RowCount
'Header info ---------------------------------------
LineCount = LineCount + 1
If LineCount = 1 Then
TabPos = 2
Printer.FontName = "Arial"
Printer.FontSize = 14: Printer.FontBold = True
Printer.Print
Printer.Print Tab(TabPos); RptName
Printer.Print 'Blank line
Printer.FontName = "Arial"
Printer.FontSize = 10: Printer.FontBold = False
Printer.Print 'Blank line
Printer.Print Tab(TabPos); RptSub
Printer.Print 'Blank line
'Table Column names ----------------------------
Printer.FontName = "Courier New"
Printer.FontSize = 9: Printer.FontBold = False
For n = 1 To MyTrueGrid.Columns
If MyTrueGrid.ColumnVisible(n) = True Then
'Calculation for Tab() positions
ColWide = MyTrueGrid.ColumnWidth(n)
ColText = MyTrueGrid.ColumnName(n)
ColStyle = MyTrueGrid.ColumnStyle(n)
'Check your table for col types and change Case as approprate
Select Case ColStyle
Case 8192 'Left-align/Read only
TabNow = TabPos
Case 8193 'Centre/Read only
TabNow = (TabPos + ColWide \ 2) - (Len(ColText) \ 2)
Case 8194 'Right-align/Read only
TabNow = (TabPos + ColWide) - Len(ColText)
End Select
Printer.Print Tab(TabNow); ColText;
TabPos = TabPos + ColWide + 2
End If
Next n
Printer.Print 'forces CR/LF at end of Row
End If
'Body Info -----------------------------------------
TabPos = 2
MyTrueGrid.RowIndex = r
For c = 1 To MyTrueGrid.Columns
MyTrueGrid.ColumnIndex = c
If MyTrueGrid.ColumnVisible(c) = True Then
'Calculation for Tab() positions
ColWide = MyTrueGrid.ColumnWidth(c)
ColText = MyTrueGrid.text 'Table.ColumnText() = unformatted
ColStyle = MyTrueGrid.ColumnStyle(c)
Select Case ColStyle
Case 8192 'Left-align/Read only
TabNow = TabPos
Case 8193 'Centre/Read only
TabNow = (TabPos + ColWide \ 2) - (Len(ColText) \ 2)
Case 8194 'Right-align/Read only
TabNow = (TabPos + ColWide) - Len(ColText)
End Select
Printer.Print Tab(TabNow); ColText;
TabPos = TabPos + ColWide + 2
End If
Next
Printer.Print 'forces CR/LF at end of Row
'Footer Info ---------------------------------------
If LineCount = 42 Then
Printer.Print 'Blank line
TabPos = (Printer.ScaleWidth \ 2) - (Len(PageFoot) \ 2)
Printer.Print Tab(TabPos); PageFoot; Printer.Page
Printer.NewPage : LineCount = 0
DoEvents 'allow Windows access at end of every page
End If
Next
'Reset display and position to 1st row / 1st column
MyTrueGrid.TopRow = 1: MyTrueGrid.RowIndex = 1
MyTrueGrid.LeftColumn = 1: MyTrueGrid.ColumnIndex = 1
DoEvents
'print page footer on last/short page ------------------
If Not LineCount = 42 Then
Do Until LineCount = 42
Printer.Print 'Blank line
LineCount = LineCount + 1
Loop
Printer.Print 'Blank line
TabPos = (Printer.ScaleWidth \ 2) - (Len(PageFoot) \ 2)
Printer.Print Tab(TabPos); PageFoot; Printer.Page
LineCount = 0
End If
' NewPage / Endoc ensures no blank page before ending print
Printer.NewPage : Printer.EndDoc
Screen.MousePointer = 0 'Return cursor to default
End Sub
> ---------8<---------8<--------- CORTAR ---------8<---------8<---------
Saludos.............. GLL