|
|
|
|
|
Dicas
|
|
Visual Basic (Grid/FlexGrid)
|
|
|
Título da Dica: Imprimir dbGrid em .TXT
|
|
|
|
Postada em 28/1/2004 por Geronimo
Em um modulo:
*************************************************************** 'Windows API/Global Declarations for :PrintGrid '*************************************************************** Declare Function ShellExecute Lib "shell32.dll" Alias _ "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _ ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long No Form: '*************************************************************** ' Name: PrintGrid ' Description:To Print DataBase Grid Control as a quick report Private Function PrintGd(ByVal GridToPrint As DBGrid, ByVal MyRecordset As Recordset) As Long Dim x, v, b Dim Putit As String Dim Myrec Dim MyField Dim TCapion Dim Mydash Screen.MousePointer = 11 Open "C:\Printed.txt" For Output As #2 Putit = "" Mydash = "-" For b = 0 To GridToPrint.Columns.Count - 1 Myrec = "" MyField = "" x = GridToPrint.Columns(b).Width x = x / 100
For v = 1 To x Mydash = Mydash + "-" If Mid(GridToPrint.Columns(b).Caption, v, 1) = "" Then Myrec = Chr(32) Else Myrec = Mid(GridToPrint.Columns(b).Caption, v, 1) End If MyField = MyField & Myrec Next v Putit = Putit & Chr(9) & MyField DoEvents
Next b
Print #2, " No" & Putit Print #2, Mydash
Close #2
Dim Colcap Dim Toprint Open "C:\Printed.txt" For Append As #1 MyRecordset.MoveFirst Dim Nox
Do While Not MyRecordset.EOF Putit = "" Nox = Nox + 1 For b = 0 To GridToPrint.Columns.Count - 1 If GridToPrint.Columns(b).Visible = True Then Myrec = "" MyField = "" x = GridToPrint.Columns(b).Width x = x / 100 For v = 1 To x DoEvents If Mid(GridToPrint.Columns(b).Text, v, 1) = "" Then Myrec = Chr(32) 'x Else Myrec = Mid(GridToPrint.Columns(b).Text, v, 1) End If MyField = MyField & Myrec Next v DoEvents Putit = Putit & Chr(9) & MyField Else End If Next b Print #1, Format(Nox, "@@@") & Putit MyRecordset.MoveNext Loop Close #1 Me.Refresh Dim RetVal As Long RetVal = ShellExecute(Me.hwnd, _ vbNullString, "C:\Printed.Txt", vbNullString, "c:\", SW_SHOWNORMAL) Screen.MousePointer = 0 End Function Private Sub Command1_Click() Dim x x = PrintGd(PrintGrid, Data1.Recordset) End Sub
|
|
|
|
|