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.
(http://r.i.elhacker.net/cache?url=http://img508.imageshack.us/img508/4697/mshflexgridtoexcel.png)
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
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
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.
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 (http://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:
(http://img194.imageshack.us/img194/8096/libroexcel01.png)
saludos
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!¡.
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://www.megaupload.com/?d=BTOQ0K3G)
http://rapidshare.com/files/400561951/Exportar_flexgrid.zip.html (http://rapidshare.com/files/400561951/Exportar_flexgrid.zip.html)
saludos y gracias por responder
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!¡.
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!¡.
Se me olvido Usa GESHI!¡.
(http://img576.imageshack.us/img576/8084/screenexcel.jpg) (http://img576.imageshack.us/my.php?image=screenexcel.jpg)
Dulce Infierno Lunar!¡.
Efectivamente como dice BlackZeroX el problema es el número de columnas. Tú haces lo siguiente:
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:
(http://img535.imageshack.us/img535/7742/30232391.gif)
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:
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
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
Cita de: hunter18 en 19 Junio 2010, 18:33 PM
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!¡.
Uhm!! ya veo asi era el asunto gracias por la aclaracion,estare pendiente haber cuando sale tu modulo de clase, saludos
Cita de: hunter18 en 20 Junio 2010, 02:17 AM
Uhm!! ya veo asi era el asunto gracias por la aclaracion,estare pendiente haber cuando sale tu modulo de clase, saludos
http://foro.elhacker.net/programacion_visual_basic/srccls_clsexcelaplication_release_memory-t297215.0.html;msg1472257#msg1472257
Puedes usar en tu caso este!¡.
' // 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 InstanciaExcel As Cls_ExcelAplication ' // Contenedor de la aplicacion Excel Con {Liberacion de Memoria} al descargar!¡).
Dim Obj_Hoja As Object
Dim Lng_UbHojas&
Dim Fila&
Dim TmpStr$
Dim Columna&
Dim CantCols&
Set InstanciaExcel = New Cls_ExcelAplication ' // Crea el objeto Excel, (Con {Liberacion de Memoria} Automatica)
If Not InstanciaExcel Is Nothing Then
With InstanciaExcel
Set Obj_Hoja = .Hoja ' // Creamos una nueva Hoja
CantCols = GetColumns&(FlexGrid)
With FlexGrid
For Fila = 1 To .Rows - 1 ' // Bucle para Exportar los datos.
For Columna = 0 To CantCols& ' // Bucle para Exportar los datos.
TmpStr$ = .TextMatrix(Fila, Columna) ' // Texto de Celda.
If IsNumeric(TmpStr$) Then TmpStr$ = "'" & TmpStr$ ' // Si es numero lo exportamos como tal {Seria como comentario...} !¡.
Obj_Hoja.cells(Fila, Columna + 1).Value = TmpStr$
Next
Next
End With
Call .Libro(, Obj_Hoja).Close(True, sOutPutPath)
Set Obj_Hoja = Nothing
End With
End If
Error_Handler:
Set InstanciaExcel = Nothing ' // Se descarga la clase y la aplicacion Excel automaticamente.
Flexgrid_To_File_FormatExcel = Not CBool(Err.Number)
Call Err.Clear
End Function
Dulce Infierno Luanr!¡.
Simplemente genial
Un trabajo excelente. Está todo bien protegido de errores.
Efectivamente lo del + y - del MSHFlexGrid es causa de la consulta, realmente no tengo tiempo para analizar.
Felicidades, muy buen trabajo.