¿Cómo generar reportas desde Visual Basic y visualizarlos en un flexgrid?

Yo en algunas de mis aplicaciones también me he encontrado en esa situación, yo lo he resuelto de la siguiente forma: (te muestro el código de una de mis aplicaciones; el ejemplo en cuestión es la impresión de un conjunto de albaranes que primero se visualizan en un grid y posteriormente, si el usuario lo desea los puede imprimir en un informe en CR).
Option Explicit
Dim cnDB As ADODB.Connection
Dim adoPrimaryRS As ADODB.Recordset
Dim sSQL As String
Private Sub Form_Load()
Set cnDB = New Connection
cnDB.CursorLocation = adUseClient
cnDB.Open "PROVIDER=Microsoft.Jet.OLEDB.3.51;Data Source=" & App.Path & "\Trans.db;"
sSQL = "SELECT IdAlbara as [Nº albarà], DAlbara as [Data albarà], " & _
"Nom as Client, Descripcio as [Descripció], " & _
"QuantTm as [Quantitat Tones], Preu as [Preu/Tona], " & _
"ImportTm as [Import] FROM AlbaraExt"
Set adoPrimaryRS = New Recordset
adoPrimaryRS.Open sSQL, cnDB, adOpenStatic, adLockOptimistic
Set dgrdCercar.DataSource = adoPrimaryRS
' Tamany i posicio del formulari
Me.Left = 250
Me.Top = 300
Me.Width = 9820
Me.Height = 7005
End Sub
Private Sub cmdClose_Click()
' Tanquem el Recordset
adoPrimaryRS.Close
Set adoPrimaryRS = Nothing
'Tanquem la base de dades
cnDB.Close
Set cnDB = Nothing
' Descarreguem el formulari
Unload Me
End Sub
Private Sub cmdImprimir_Click()
Dim sWHERE As String
Dim iAny As Integer
Dim iMes As Integer
Dim iDia As Integer
Dim sData As String
' Selecció del registres a imprimir
sWHERE = WhereFormula()
If Trim(txtDesdeData.Text) <> "" Then
sData = Format(CDate(txtDesdeData.Text), "dd-mm-yyyy")
iDia = Piece(sData, "-", 1)
iMes = Piece(sData, "-", 2)
iAny = Piece(sData, "-", 3)
If sWHERE <> "" Then sWHERE = sWHERE & " AND "
sWHERE = sWHERE & "{AlbaraExt.DAlbara}>=Date(" & iAny & "," & iMes & "," & iDia & ")"
End If
If Trim(txtFinsData.Text) <> "" Then
sData = Format(CDate(txtFinsData.Text), "dd-mm-yyyy")
iDia = Piece(sData, "-", 1)
iMes = Piece(sData, "-", 2)
iAny = Piece(sData, "-", 3)
If sWHERE <> "" Then sWHERE = sWHERE & " AND "
sWHERE = sWHERE & "{AlbaraExt.DAlbara}<=Date(" & iAny & "," & iMes & "," & iDia & ")"
End If
If sWHERE <> "" Then
sWHERE = ReplaceText(sWHERE, "[", "{")
sWHERE = ReplaceText(sWHERE, "]", "}")
End If
CRLlistats.DataFiles(0) = App.Path & "\Trans.db"
CRLlistats.ReportFileName = App.Path & "\Albara.rpt"
CRLlistats.SelectionFormula = sWHERE
CRLlistats.WindowState = crptMaximized
CRLlistats.Action = 1
End Sub
Private Sub cmdBuscar_Click()
Dim sSQLAux As String
Dim sWHERE As String
' Selecció del registres a imprimir
sWHERE = WhereFormula()
If Trim(txtDesdeData.Text) <> "" Then
If sWHERE <> "" Then sWHERE = sWHERE & " AND "
sWHERE = sWHERE & "AlbaraExt.DAlbara >= CDate('" & txtDesdeData.Text & "')"
End If
If Trim(txtFinsData.Text) <> "" Then
If sWHERE <> "" Then sWHERE = sWHERE & " AND "
sWHERE = sWHERE & "AlbaraExt.DAlbara <= CDate('" & txtFinsData.Text & "')"
End If
If sWHERE <> "" Then
sWHERE = ReplaceText(sWHERE, "]", "")
sWHERE = ReplaceText(sWHERE, "[", "")
sSQLAux = sSQL & " WHERE " & sWHERE
Else
sSQLAux = sSQL
End If
sSQLAux = sSQLAux & " ORDER BY AlbaraExt.IdAlbara"
Set adoPrimaryRS = cnDB.Execute(sSQLAux)
Set dgrdCercar.DataSource = adoPrimaryRS
End Sub
Private Function WhereFormula() As String
Dim sIAlbara As String
Dim sFAlbara As String
Dim sIClient As String
Dim sFClient As String
Dim sIData As String
Dim sFData As String
Dim sSQL As String
Dim sSQLAux As String
On Error GoTo Err_Imprimir
WhereFormula = ""
sIAlbara = Trim(txtDesdeAlbara.Text)
sFAlbara = Trim(txtFinsAlbara.Text)
sIClient = Trim(txtDesdeClient.Text)
sFClient = Trim(txtFinsClient.Text)
sIData = Trim(txtDesdeData.Text)
sFData = Trim(txtFinsData.Text)
If bVerificarParametres(sIAlbara, sFAlbara) = False Then Err.Raise -1
If bVerificarParametres(sIClient, sFClient) = False Then Err.Raise -1
If bVerificarParametres(sIData, sFData) = False Then Err.Raise -1
sSQL = ""
If sIAlbara <> "" Or sFAlbara <> "" Then
If sSQL <> "" Then sSQL = sSQL & " AND "
sSQLAux = "[AlbaraExt.IdAlbara] >=" & sIAlbara & _
" AND [AlbaraExt.IdAlbara]<=" & sFAlbara
sSQL = sSQL & sSQLAux
End If
If sIClient <> "" Or sFClient <> "" Then
If sSQL <> "" Then sSQL = sSQL & " AND "
sSQLAux = "[AlbaraExt.Nom]>='" & sIClient & "'" & _
" AND [AlbaraExt.Nom]<='" & sFClient & "'"
sSQL = sSQL & sSQLAux
End If
WhereFormula = sSQL
Exit Function
Err_Imprimir:
If Err.Number = -1 Then
MsgBox "Els paràmetres seleccionats son incorrectes perquè:" & vbCrLf & _
" * Falta algún dels paràmetres de la parella" & vbCrLf & _
" * El primer paràmetre i el segon són de diferents tipus" & vbCrLf & _
" * El primer paràmetre es més gran que el segon", vbCritical
Exit Function
Else
MsgBox "Error: " & Err.Number & vbCrLf & Err.Description, vbCritical
End If
End Function