Data Report en tiempo de ejecución, AYUDAAAA!!! :(

Question

Hola mis amigos del foro MSDN!! Regreso de nuevo en esta gran comunidad de programadores, en esta ocasión acudo a ustedes para que asistan en otro problema que tengo, anteriormente consulte sobre un error mientras desarrollaba una aplicación de VB 6.0 que maneja el lenguaje ADO para interactuar con Base de Datos Access 2000, seguidamente me tope con la dificultad de hacerla funcionar en windows 7 32/64 bits (pues la habia desarrollado en plataforma windows xp 32 bits). Ambos problemas los he logrado solucionar gracias a ustedes y estoy cerca de finalizar la aplicación pero ahora tengo este verdadero dolor de cabeza como lo son los reportes.

He revisado en un sin fin de foros y guias, y la mayoria apelan por el uso de otras herramientas tales como Crystal Reports, Report Manager y otras, en busqueda de la respuesta de crear (por la naturaleza del reporte/factura) un reporte de manera dinámica, ya que necesito reflejar en este diferentes tipos de equipos, cada uno con modelos o variantes distintas y los seriales de cada equipo. Además esta el otro inconveniente de que necesito que el archivo de base de datos access no este fija en una carpeta sino que se pueda cargar desde cualquier parte del ordenador (para llenar listviews, por ejemplo, primero agregue un commondialog de abrir para que la ruta la almacenara en una variable global, declarada en un modulo .bas), razón por la cual estoy tambien inhabilitado para usar el dataenvironment u otro programa (crystal report, report manager, etc) que necesite una ruta fija hacia el archivo para la cadena de conexión, quedandome la opción solo de cargar el reporte con objetos recordsets y enlazandolos a labels de reporte en tiempo de ejecución.

El formato que debo construir para el reporte seria algo como esto:  

-Ya no hallo que hacer, intenté crear una tabla solo para reportes por cada tipo de equipo y cargar un solo registro con todos los seriales en un campo en la seccion "page header" (se me repetian y el reporte tomaba dimensiones de varias páginas en vez de una), ya he buscado en muchisimos foros sobre crear objetos de reporte en tiempo de ejecución, sin resultado aparente, estoy desesperado, Ayudaaaa!!! :(

Este es mi intento en codigo para cargar el reporte en tiempo de ejecución, posee 6 labels "rptlabel" logra cargar los datos de la base de datos sin problemas, pero como ven tengo dificil la logica para realizar reporte de distintos tipos de equipos, cada uno con distintos modelos...

------------------------------------

DBpath = Variable global del modulo .bas

rsne = recordset para notas de entrega

dr = Objeto Datareport

-----------------------------------------------------------------

CODIGO

----------------------------------------------------------------

Private Sub Command1_Click()
Dim rsne As New ADODB.Recordset
Dim cn As New ADODB.Connection
Dim dr As New DataReport1
Dim labelnroequipos As Integer
Set cn = New ADODB.Connection
Set rsne = New ADODB.Recordset
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & DBpath

If rsne.State = 1 Then
    rsne.Close
    rsne.Source = "NOTA_ENTREGA_BCP"
    rsne.CursorType = adOpenKeyset
    rsne.LockType = adLockOptimistic
    rsne.Open "select * from NOTA_ENTREGA_BCP", cn
Else
    rsne.Source = "NOTA_ENTREGA_BCP"
    rsne.CursorType = adOpenKeyset
    rsne.LockType = adLockOptimistic
    rsne.Open "select * from NOTA_ENTREGA_BCP", cn
End If
If rsne.RecordCount <> 0 Then
    rsne.MoveFirst
    With dr.Sections("Equipos")
        With .Controls
        .Item("label48").Caption = rsne("equipo").Value
        .Item("label50").Caption = rsne("serial").Value
        .Item("label51").Caption = rsne("cantidad").Value
        .Item("label51").Top = .Item("label50").Top
        labelnroequipos = rsne("cantidad").Value
        If labelnroequipos <= 10 Then
            .Item("label50").Height = 152
        ElseIf labelnroequipos > 10 And labelnroequipos <= 20 Then
            .Item("label50").Height = 303
        ElseIf labelnroequipos > 20 And labelnroequipos <= 30 Then
            .Item("label50").Height = 455
        ElseIf labelnroequipos > 30 And labelnroequipos <= 40 Then
            .Item("label50").Height = 606
        ElseIf labelnroequipos > 40 And labelnroequipos <= 50 Then
            .Item("label50").Height = 758
        ElseIf labelnroequipos > 50 And labelnroequipos <= 60 Then
            .Item("label50").Height = 910
        ElseIf labelnroequipos > 60 And labelnroequipos <= 70 Then
            .Item("label50").Height = 1061
        ElseIf labelnroequipos > 70 And labelnroequipos <= 80 Then
            .Item("label50").Height = 1213
        Else
            .Item("label50").Height = 1364
        End If
        End With
        rsne.Close
        rsne.Source = "NOTA_ENTREGA_BOP"
        rsne.CursorType = adOpenKeyset
        rsne.LockType = adLockOptimistic
        rsne.Open "select * from NOTA_ENTREGA_BOP", cn
    End With
End If
If rsne.RecordCount <> 0 Then
    rsne.MoveFirst
    With dr.Sections("Equipos")
        With .Controls
            .Item("label52").Caption = rsne("equipo").Value
            .Item("label52").Top = .Item("label50").Top + .Item("label50").Height + 30
            .Item("label53").Top = .Item("label52").Top + .Item("label52").Height - 12
            .Item("label54").Top = .Item("label52").Top + .Item("label52").Height + 3
            .Item("label55").Top = .Item("label54").Top
            .Item("label54").Caption = rsne("serial").Value
            .Item("label55").Caption = rsne("cantidad").Value
            labelnroequipos = rsne("cantidad").Value
            If labelnroequipos <= 12 Then
                .Item("label54").Height = 152
            ElseIf labelnroequipos > 12 And labelnroequipos <= 24 Then
                .Item("label54").Height = 303
            ElseIf labelnroequipos > 24 And labelnroequipos <= 36 Then
                .Item("label54").Height = 455
            ElseIf labelnroequipos > 36 And labelnroequipos <= 48 Then
                .Item("label54").Height = 606
            ElseIf labelnroequipos > 48 And labelnroequipos <= 60 Then
                .Item("label54").Height = 758
            ElseIf labelnroequipos > 60 And labelnroequipos <= 72 Then
                .Item("label54").Height = 910
            ElseIf labelnroequipos > 72 And labelnroequipos <= 84 Then
                .Item("label54").Height = 1061
            ElseIf labelnroequipos > 84 And labelnroequipos <= 96 Then
                .Item("label54").Height = 1213
            Else
                .Item("label54").Height = 1364
            End If
        End With
        rsne.Close
        rsne.Source = "NOTA_ENTREGA_BOP"
        rsne.CursorType = adOpenKeyset
        rsne.LockType = adLockOptimistic
        rsne.Open "select * from NOTA_ENTREGA_BOP", cn
    End With
End If
Set dr.DataSource = rsne
dr.Show
End Sub

------------------------------------------------------------------------------

Gracias de antemano

 PD: Soy un novicio en programacion y VB, si tienen una respuesta, agradeceria la orientacion necesaria jejeje...mi programa usa lenguaje ADO y accesa a archivo de base de datos microsoft access 2000.

Answer 1

Hola paisano. ¿Ese reporte puede 'salir' como documento HTML?

Answer 2

Es una opción, mi idea era crear el reporte como te lo proporciona el visual basic por defecto, tipo vista previa con sus botones de exportar/imprimir, y en la opcion de imprimir (con la ayuda del pdf creator) guardar el reporte en formato .pdf , para que se viera mas presentable, pero en html tambien me sirve

Answer 3

Espero no complicarte la vida, pero ultimamente estoy utilizando mucho la salida en formato HTML.

Puedes ver la salida aquí y descargar la mdb que lo crea aquí

Agrego: en la carpeta que descargues el mdb, se creará el archivo reporte.html

Answer 4

Y como podria hacer yo para hacer el reporte en formato excel? es que en html estoy como limitado porque se necesitan cargar tambien un logo, y bueno tambien como don de estoy ahorita, todos los repostes de entrega de equipos se guardan en formato excel, me hicieron la peticion a dicho formato..

Por ahi he visto una imagen por internet de una ventana de VB con una hoja de Excel cargada tipo reporte..Existirá algun manual para hacer reportes partiendo de VB6 con base de datos access y guardarlo en formato excel??

Gracias de antemano

Answer 5

ese mismo código, cambia la extensión html por xls.

Hay maneras mas 'profesionales' de hacerlo, creando instancia de excel, e insertando linea a linea.

En el siguiente ejemplo, se lee de una tabla de access; se abre un documento de excel que ya tiene un formato; se inserta nuevos registros y se guarda con otro nombre.

Private Sub Comando11_Click()
    
Dim rst As New ADODB.Recordset, strSQL As String, i As Long, lngCuenta As Long, fiLa As Long, desTino As String, q As Integer
On Error GoTo lbl_error
Dim xls As Object 'New Excel.Application
Set xls = CreateObject("Excel.Application")
inicia = 0
xls.Workbooks.Open CurrentProject.Path & "\plantillas\AntSal.xlsx" 'ESTA ES LA PLANTILLA

' construyo un recordset con los registros a insertar en cada hoja
strSQL = "SELECT DISTINCTROW CLIE01.CCLIE, CLIE01.nombre, CLIE01.RFC, CLIE01.Dir, CLIE01.POB, CLIE01.CODIGO FROM CLIE01 INNER JOIN vencimientos ON CLIE01.CCLIE = vencimientos.CCLIE;"
Set conn = CurrentProject.Connection
    rst.Open strSQL, conn, 2, 4
    If Not (rst.EOF And rst.BOF) Then
        arreglo = rst.GetRows()
        rst.Close
        Set rst = Nothing
        
        ' pego los datos en la hoja
        fiLa = 8:  nomFila = "A8": rfcFila = "B9": dirFila = "B10": pobFila = "B11": codFila = "F11"
        q = UBound(arreglo, 2)
        For k = 0 To q
            If parar = True Then
                xls.ActiveWorkbook.Close False
                parar = False
                MsgBox "Proceso detenido por el usuario.", vbExclamation, "Exportando a Microsoft Excel"
                Exit Sub
            End If
            i = 1
            nid.Open "SELECT REFERENCIA, corriente, treinta, sesenta, noventa, mas, fecha FROM vencimientos WHERE CCLIE='" & arreglo(0, k) & "'", conn, 1, 2
            refs = nid.RecordCount
            If Not nid.EOF Then
                With xls.Worksheets(1)
                    If inicia = 0 Then
                        inicia = 15
                    Else
                        inicia = inicia + 13
                        desTino = "A" & fiLa - 1 & ""
                        .Range("A7:H14").Copy .Range(desTino)
                    End If
                                
                    .Range(nomFila).Value = arreglo(1, k) 'rst!nombre
                    .Range(rfcFila).Value = arreglo(2, k) 'rst!RFC
                    .Range(dirFila).Value = arreglo(3, k) 'rst!Dir
                    .Range(pobFila).Value = arreglo(4, k) 'rst!POB
                    .Range(codFila).Value = arreglo(5, k) 'rst!CODIGO
                    Do Until nid.EOF
                        hasta = "A" & inicia & ""
                        xRango = "C" & inicia & ":G" & inicia & ""
                        .Range(xRango).NumberFormat = "[$$-80A]#,##0.00"
                        .Range(hasta).Value = nid(6) 'fecha
                        .Range(hasta).NumberFormat = "dd/mm/yyyy"
                        .Range("B" & inicia & "").Value = nid(0) 'referencia
                        .Range("C" & inicia & "").Value = nid(1) 'corriente
                        .Range("D" & inicia & "").Value = nid(2) '30
                        .Range("E" & inicia & "").Value = nid(3) '60
                        .Range("F" & inicia & "").Value = nid(4) '90
                        .Range("G" & inicia & "").Value = nid(5) 'mas
                        xdesde = "A" & inicia & ""
                        xhasta = "G" & inicia & ""
                        rango = xdesde & ":" & xhasta
                        nid.MoveNext
                        .Range(rango).Borders.LineStyle = 1
                        .Range(rango).HorizontalAlignment = 2
                        inicia = inicia + 1
                        DoEvents
                        If q > 0 Then
                            barra1.Width = i * 6200 / refs
                        Else
                            barra1.Width = 6200
                        End If
                        i = i + 1
                        Me.Repaint
                     Loop
                     If nid.State = 1 Then
                        nid.Close
                        Set nid = Nothing
                        fiLa = inicia + 6
                        nomFila = "A" & fiLa & ""
                        rfcFila = "B" & fiLa + 1 & ""
                        dirFila = "B" & fiLa + 2 & ""
                        pobFila = "B" & fiLa + 3 & ""
                        codFila = "F" & fiLa + 3 & ""
                     End If
                End With
            End If
            DoEvents
            If q > 0 Then
               barra.Width = k * 6200 / q
               r = Abs(k / q * 255)
               barra.BackColor = RGB(r, r, r)
            End If
            barra1.Width = 0
            Me.Repaint
        Next k
    End If
conn.Close
Set conn = Nothing

aux = Format(Now(), "yyyy-mm-dd-hhmm")
xls.ActiveWorkbook.SaveAs CurrentProject.Path & "\reportes\AntSal-" & aux & ".xlsx"
xls.Quit
Set xls = Nothing
FollowHyperlink CurrentProject.Path & "\reportes\AntSal-" & aux & ".xlsx", , True
lbl_salir:
    Exit Sub
lbl_error:
    xls.ActiveWorkbook.Close False
    xls.Quit
    Set xls = Nothing
    Resume lbl_salir
End Sub