USUÁRIO:      SENHA:        SALVAR LOGIN ?    Adicione o VBWEB na sua lista de favoritos   Fale conosco 

 

  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


 


CyberWEB Network Ltda.    © Copyright 2000-2019   -   Todos os direitos reservados.
Powered by HostingZone - A melhor hospedagem para seu site
Topo da página