Ver Mensaje Individual
  #2 (permalink)  
Antiguo 19/08/2014, 13:15
t0n1
 
Fecha de Ingreso: noviembre-2010
Mensajes: 175
Antigüedad: 14 años, 1 mes
Puntos: 1
Respuesta: Exportar datagrid a excel

Corregí el código y pude solucionar el problema. Lo que ocurre ahora es que se genera el excel pero sólo muestra los encabezados de las columnas sin ningún registro.

Acá está el código nuevo:

Código:
Public Function Exportar_Excel(sOutputPath As String, DataGrid As Object) As Boolean
  
    On Error GoTo Error_Handler
      
    
  
   
    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
     
     iCol = 0
        ' --  Recorrer el Datagrid ( Las columnas )
        For i = 0 To DataGrid.Columns.Count - 1
            If DataGrid.Columns(i).Visible Then
                ' -- Incrementar índice de columna
                iCol = iCol + 1
                ' -- Obtener el caption de la columna
                o_Hoja.Cells(1, iCol) = DataGrid.Columns(i).Caption
                ' -- Recorrer las filas
                For j = 0 To n_Filas - 1
                    ' -- Asignar el valor a la celda del Excel
                    o_Hoja.Cells(j + 2, iCol) = _
                    DataGrid.Columns(i).CellValue(DataGrid.GetBookmark(j))
                Next
            End If
        Next
       o_Libro.Close True, sOutputPath
    ' -- Cerrar Excel
    o_Excel.Quit
    ' -- Terminar instancias
    Call ReleaseObjects(o_Excel, o_Libro, o_Hoja)
    Exportar_Excel = 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