Como exportar MSHFlexgrid1 a Excel? - Expertos en vb6.0

[hunter18]

Tengo un codigo y funciona bien pero cuando el MSHFlexgrid1 tiene agrupaciones como en la imagen solo me imprime los encabezados Procesadores, Monitores, Televisores que pertenecen a la tabla categoria.

Código [Seleccionar] Expandir


Dim rs As New ADODB.Recordset
Dim cn As New ADODB.Connection

Private Sub Command1_Click()

sSQL = "SHAPE {SELECT codcat,nomcat FROM categoria} AS CABECERA " & _
"APPEND ({SELECT codprod,nomprod,codcat FROM producto} AS DETALLE " & _
"RELATE codcat TO codcat) AS DETALLE"

rs.StayInSync = False
'cn.Open "Provider=MSDataShape.1;Extended Properties=Jet OLEDB:Database Password=;Persist Security Info=False;Data Source=c:\bd_01.mdb;Data Provider=MICROSOFT.JET.OLEDB.4.0"
cn.Open "Provider=MSDataShape.1;Extended Properties=Jet OLEDB:Database Password=;Persist Security Info=False;Data Source=" & App.Path & "\bd_01.mdb;Data Provider=MICROSOFT.JET.OLEDB.4.0"
   
rs.Open sSQL, cn

Set MSHFlexGrid1.DataSource = rs

End Sub


Código [Seleccionar] Expandir


Private Sub Command2_Click()
Call Exportar_HFlexgrid(App.Path & "\excel1.xls", MSHFlexGrid1)
End Sub


' -------------------------------------------------------------------------------------------
' \\ -- Función para crear un nuevo libro con el contenido del Grid
' -------------------------------------------------------------------------------------------
Public Function Exportar_HFlexgrid(sOutputPath As String, FlexGrid As Object) As Boolean
 
   On Error GoTo Error_Handler
 
   Dim o_Excel     As Object
   Dim o_Libro     As Object
   Dim o_Hoja      As Object
   Dim Fila        As Long
   Dim Columna     As Long
     
   ' -- Crea el objeto Excel, el objeto workBook y el objeto sheet
   Set o_Excel = CreateObject("Excel.Application")
   Set o_Libro = o_Excel.Workbooks.Add
   Set o_Hoja = o_Libro.Worksheets.Add
     
   ' -- Bucle para Exportar los datos
   With FlexGrid
       For Fila = 1 To .Rows - 1
           For Columna = 0 To .Cols - 1
               o_Hoja.Cells(Fila, Columna + 1).Value = .TextMatrix(Fila, Columna)
           Next
       Next
   End With
   o_Libro.Close True, sOutputPath
   ' -- Cerrar Excel
   o_Excel.Quit
   ' -- Terminar instancias
   Call ReleaseObjects(o_Excel, o_Libro, o_Hoja)
   Exportar_HFlexgrid = True
Exit Function
 
' -- Controlador de Errores
Error_Handler:
   ' -- Cierra la hoja y el la aplicación Excel
   If Not o_Libro Is Nothing Then: o_Libro.Close False
   If Not o_Excel Is Nothing Then: o_Excel.Quit
   Call ReleaseObjects(o_Excel, o_Libro, o_Hoja)
   If Err.Number <> 1004 Then MsgBox Err.Description, vbCritical
End Function
' -------------------------------------------------------------------
' \\ -- Eliminar objetos para liberar recursos
' -------------------------------------------------------------------
Private Sub ReleaseObjects(o_Excel As Object, o_Libro As Object, o_Hoja As Object)
   If Not o_Excel Is Nothing Then Set o_Excel = Nothing
   If Not o_Libro Is Nothing Then Set o_Libro = Nothing
   If Not o_Hoja Is Nothing Then Set o_Hoja = Nothing
End Sub


[karmany]

Prueba a modificar la propiedad del MSHFlexgrid: .MergeCells = flexMergeFree
Si le pones la propiedad sin combinar creo que te dará correcto, pero la presentación del control no será la adecuada.

¿Cómo haces para que te salga a la izquierda el + o - para expandir o contraer las filas? No sé si será una propiedad pues yo he modificado creo que todas y no lo logro, pero es posible que tu problema tenga que ver con eso.

[hunter18]

Gracias por responder kermany.
No he modificado ninguna propiedad del MSHFlexgrid1 la agrupacion que vez y el simbolo mas y menos se genera automaticamente debido a la consulta SQL que utilizo con SHAPE, APPEND y RELATE

Aqui se explica sobre eso pero con treeview's lo unico que he hecho es pasar el recordset a un Hierarchical Flexgrid que para es dicho control aunque no he encontrado mucha info sobre estohttp://personal.lobocom.es/claudio/ado001.htm

No funciono aplicando .MergeCells = flexMergeFree y repito no he moidficado ninguna propiedad del MSHFlexgrid1 simplemente agrego el control al form y listo.

Espero alguien del foro pueda ayudarme! lo que devuelve al ejecutar es esto parece que hay que modificar la funcion:


saludos

[BlackZeroX]

Podrias poner un archivo ".mdb" aquí, nunca he tenido que procesar un MSHFlexgrid1 con celdas combinadas ( es para ayudarte!¡. )

P.D.: No tengo Access ni nada de Offices por aqui xP.

Dulce Infierno Lunar!¡.

[hunter18]

Dejo el archivo .mdb y el proyecto en rapidshare y megaupload para que lo descargues y no haya problema si alguno no funciona.

http://www.megaupload.com/?d=BTOQ0K3G
http://rapidshare.com/files/400561951/Exportar_flexgrid.zip.html

saludos y gracias por responder

[BlackZeroX]

Bueno la cosa es que en el FlexGrid cols da solo la cantidad de 2 es decir de tu tabla de Categorias pero no toma encuenta las demas con un simple proceso se soluciona!¡.

Código (vb) [Seleccionar] Expandir




Option Explicit

Private WithEvents TmpAdoConector              As Cls_AdoConector      '   //  Modulo de clase para trabajar de forma limpia sobre el codigo xP.

' -------------------------------------------------------------------------------------------
' \\ -- Función para contar las Columnas REALES de un MSHFlexgrid.
' -------------------------------------------------------------------------------------------
Private Function GetColumns&(ByRef FlexGrid As MSHFlexgrid)
On Error GoTo Terminar
Dim Res$
   Res$ = Space(1)
   Do
       Res$ = FlexGrid.TextMatrix(0, GetColumns&)
       GetColumns& = GetColumns& + 1
   Loop Until Not Err.Number <= 0
Terminar:
   GetColumns& = GetColumns& - 1
   Err.Clear
End Function
' -------------------------------------------------------------------------------------------
' \\ -- Función para crear un nuevo libro con el contenido del MSHFlexgrid
' -------------------------------------------------------------------------------------------
Public Function Flexgrid_To_File_FormatExcel(ByVal sOutPutPath As String, ByRef FlexGrid As MSHFlexgrid) As Boolean
On Error GoTo Error_Handler
Dim Obj_Excel       As Object
Dim Obj_Libro       As Object
Dim Obj_Hoja        As Object
Dim Fila&
Dim TmpStr$
Dim Columna&
Dim CantCols&
     
   ' -- Crea el objeto Excel, el objeto workBook y el objeto sheet
   Set Obj_Excel = CreateObject("Excel.Application")
   If Not Obj_Excel Is Nothing Then
       Set Obj_Libro = Obj_Excel.Workbooks.Add
       If Not Obj_Libro Is Nothing Then
           Set Obj_Hoja = Obj_Libro.Worksheets.Add
           If Not Obj_Hoja Is Nothing Then
               
               ' -- Bucle para Exportar los datos
               CantCols = GetColumns&(FlexGrid)
               With FlexGrid
                   For Fila = 1 To .Rows - 1
                       For Columna = 0 To CantCols&
                           TmpStr$ = .TextMatrix(Fila, Columna)
                           If IsNumeric(TmpStr$) Then TmpStr$ = "'" & TmpStr$
                           Obj_Hoja.Cells(Fila, Columna + 1).Value = TmpStr$
                       Next
                   Next
               End With
               
               Obj_Libro.Close True, sOutPutPath
               Call Obj_Excel.Quit
               
               Set Obj_Hoja = Nothing
               Set Obj_Libro = Nothing
               Set Obj_Excel = Nothing
               
               Flexgrid_To_File_FormatExcel = True
               
           End If
       End If
   End If
   Exit Function
Error_Handler:
   Flexgrid_To_File_FormatExcel = False
   Call Err.Clear
End Function



Private Sub Cmd_Export_Click()
   Call MsgBox(IIf(Flexgrid_To_File_FormatExcel("C:\Excel.xls", MS_DataGrid), "Exportacion Exitosa", "Exportacion Fallida"))
End Sub

Private Sub Cmd_LoadData_Click()
'Dim TmpAdoConector              As Cls_AdoConector      '   //  Modulo de clase para trabajar de forma limpia sobre el codigo xP.
Dim TmpRecordSet                As ADODB.Recordset

   Set TmpAdoConector = New Cls_AdoConector
   With TmpAdoConector
       .ConectionType = Other
       .ConnectionString = "Provider               =   MSDataShape.1;" & _
                           "Extended Properties    =   Jet OLEDB:Database Password=;" & _
                           "Persist Security Info  =   False;" & _
                           "Data Source            =   c:\bd_01.mdb;" & _
                           "Data Provider          =   MICROSOFT.JET.OLEDB.4.0"
       Set TmpRecordSet = .GetNew_RecordSet( _
                                           "SHAPE {SELECT codcat,nomcat FROM categoria} AS CABECERA " & _
                                           "APPEND ({SELECT codprod,nomprod,codcat FROM producto} AS DETALLE " & _
                                           "RELATE codcat TO codcat) AS DETALLE" _
                                           )
       If Not TmpRecordSet Is Nothing Then
           Set MS_DataGrid.DataSource = TmpRecordSet
           With TmpRecordSet
               Call .Close
               Call .ActiveConnection.Close
           End With
           Set TmpRecordSet = Nothing
       End If
   End With
   Set TmpAdoConector = Nothing
End Sub

Private Sub TmpAdoConector_ErrorEvent(InfoError As ErrObject)
   With Err
       Debug.Print ""
       Debug.Print String$(30, "-")
       Debug.Print "Source:"; .Source
       Debug.Print "Number:"; .Number
       Debug.Print "Description:"; .Description
       Debug.Print String$(30, "-")
       Debug.Print ""
   End With
End Sub



Dulce Infierno Lunar!¡.

[BlackZeroX]

Se me olvido Usa GESHI!¡.



Dulce Infierno Lunar!¡.

[karmany]

Efectivamente como dice BlackZeroX el problema es el número de columnas. Tú haces lo siguiente:

Código (vb) [Seleccionar] Expandir

With FlexGrid
        For Fila = 1 To .Rows - 1
            For Columna = 0 To .Cols - 1
                o_Hoja.Cells(Fila, Columna + 1).Value = .TextMatrix(Fila, Columna)
            Next
        Next
End With

y el valor de .Cols no es correcto.

El problema viene porque tienes dos tablas relacionadas:


Decir que el código de BlackZeroX me parece muy bueno y se puede utilizar de forma general. Lo que dará error será Cls_AdoConector, parece ser un módulo de clase que desconozco.

Sabiendo que sólo vas a tener 5 columnas puedes hacer:
   

Código (vb) [Seleccionar] Expandir

With FlexGrid
        For Fila = 1 To .Rows - 1
            For Columna = 1 To 5
                o_Hoja.Cells(Fila, Columna).Value = .TextMatrix(Fila, Columna)
            Next
        Next
    End With

[hunter18]

BlackZeroX excelente tus funciones, el codigo que tenia solo cogia las 2 primeras columnas lo cual solucionaste con tu funcion GetColumns, se agradece el tiempo empleado.

karmany, gracias por la aclaracion sobre donde estaba el error de logica y para utilizar el codigo de BlackZeroX basta con hacerlo con sus 2 funciones, la clase Cls_AdoConector es un modulo asumo que creado por BlackZeroX para facilitarse la tarea de conexion.

Finalmente podrian comentar como trabaja la funcion  GetColumns y tambien por que solo tomaba las dos primeras columnas las cuales estaban agrupadas si supuestamente MSHFlexGrid1.Cols recupera el numero de columnas de los encabezados?, de todas maneras voy a revisar el codigo.

saludos

[BlackZeroX]

Finalmente podrian comentar como trabaja la funcion  GetColumns y tambien por que solo tomaba las dos primeras columnas las cuales estaban agrupadas si supuestamente MSHFlexGrid1.Cols recupera el numero de columnas de los encabezados?, de todas maneras voy a revisar el codigo.

Lo que pasa es que .Cols te va a devolver lo de tu primer FlexGrid aqui hay dos bueno se puede decir que son dos!¡ FlexGrid solo que anidados segun tu sentencia SQL (creo que es PL/SQL peo no estoy seguro...)

Bien bien si ven en el FlexGrid tiene los signos de -/+ para contraer los datos bueno cuando se contraen se muestran las Verdades Columnas del FlexGrid es decir de tu tabla categorias y los que fueron contraidos son los de tu tabla de Productos o algo asi se llamaban xP jeje. Bien la cosa es que solo va a contar las columnas de tu primera sentencia es decir de tu Tabla Columnas tal cual se lo as indicado en tu sentencia SQL

P.D.: NO TIENE NADA QUE VER la relacion de tablas dentro de Access o de una Base de datos, ya que una sentencia SQL puede ignorar (en este caso lo hace) las relaciones.

Nota:
-> * Es mejor hacer un modulo de Clase para contener el objecto de Excel, ya que si la funcion se ve interrumpida o terminada la aplicacion por X motivo el Release Memory no se ejecutara (Ando haciendo un modulo de Clase pequeño y ergonomico cuando lo acabe lo publico en un nuevo Tema)!¡.

Dulce Infierno Lunar!¡.