EXPORTAR DATAGRID A EXCEL
buenas noches,
Estoy intentando exportar el resultado de un consulta que se muestra en un datagrid a excel. He localizado el siguiente código, pero solo me muestra en encabezado de las columnas y no los datos resultantes de la consulta. Me pueden ayudar? un saludo.
On Error GoTo Error_Handler
Dim i As Integer
Dim j As Integer
' -- Colocar el cursor de espera mientras se exportan los datos
Me.MousePointer = vbHourglass
If n_filas = 0 Then
MsgBox "No hay datos para exportar a excel. Se ha indicado 0 en el parámetro Filas ": Exit Sub
Else
' -- Crear nueva instancia de Excel
Set OBJ_EXCEL = CreateObject("Excel.Application")
' -- Agregar nuevo libro
Set OBJ_LIBRO = OBJ_EXCEL.Workbooks.Open(Path)
' -- Referencia a la Hoja activa ( la que añade por defecto Excel )
Set obj_hoja = OBJ_EXCEL.ActiveSheet
icol = 0
' -- Recorrer el Datagrid ( Las columnas )
For i = 0 To DGgeneral.Columns.Count - 1
If DGgeneral.Columns(i).Visible Then
' -- Incrementar Ãndice de columna
icol = icol + 1
' -- Obtener el caption de la columna
obj_hoja.Cells(1, icol) = DGgeneral.Columns(i).Caption
' -- Recorrer las filas
For j = 0 To n_filas - 1
' -- Asignar el valor a la celda del Excel
obj_hoja.Cells(j + 2, icol) = _
DGgeneral.Columns(i).CellValue(DGgeneral.GetBookmark(j))
Next
End If
Next
' -- Hacer excel visible
OBJ_EXCEL.Visible = True
' -- Opcional : colocar en negrita y de color rojo los enbezados en la hoja
With obj_hoja
.Rows(1).Font.Bold = True
.Rows(1).Font.Color = vbRed
' -- Autoajustar las cabeceras
.Columns("A:Z").AutoFit
End With
End If
' -- Eliminar las variables de objeto excel
Set obj_hoja = Nothing
Set OBJ_LIBRO = Nothing
Set OBJ_EXCEL = Nothing
' -- Restaurar cursor
Me.MousePointer = vbDefault
Exit Sub
' -- Error
Error_Handler:
MsgBox Err.Description, vbCritical
On Error Resume Next
Set obj_hoja = Nothing
Set OBJ_LIBRO = Nothing
Set OBJ_EXCEL = Nothing
Me.MousePointer = vbDefault
End Sub
Estoy intentando exportar el resultado de un consulta que se muestra en un datagrid a excel. He localizado el siguiente código, pero solo me muestra en encabezado de las columnas y no los datos resultantes de la consulta. Me pueden ayudar? un saludo.
On Error GoTo Error_Handler
Dim i As Integer
Dim j As Integer
' -- Colocar el cursor de espera mientras se exportan los datos
Me.MousePointer = vbHourglass
If n_filas = 0 Then
MsgBox "No hay datos para exportar a excel. Se ha indicado 0 en el parámetro Filas ": Exit Sub
Else
' -- Crear nueva instancia de Excel
Set OBJ_EXCEL = CreateObject("Excel.Application")
' -- Agregar nuevo libro
Set OBJ_LIBRO = OBJ_EXCEL.Workbooks.Open(Path)
' -- Referencia a la Hoja activa ( la que añade por defecto Excel )
Set obj_hoja = OBJ_EXCEL.ActiveSheet
icol = 0
' -- Recorrer el Datagrid ( Las columnas )
For i = 0 To DGgeneral.Columns.Count - 1
If DGgeneral.Columns(i).Visible Then
' -- Incrementar Ãndice de columna
icol = icol + 1
' -- Obtener el caption de la columna
obj_hoja.Cells(1, icol) = DGgeneral.Columns(i).Caption
' -- Recorrer las filas
For j = 0 To n_filas - 1
' -- Asignar el valor a la celda del Excel
obj_hoja.Cells(j + 2, icol) = _
DGgeneral.Columns(i).CellValue(DGgeneral.GetBookmark(j))
Next
End If
Next
' -- Hacer excel visible
OBJ_EXCEL.Visible = True
' -- Opcional : colocar en negrita y de color rojo los enbezados en la hoja
With obj_hoja
.Rows(1).Font.Bold = True
.Rows(1).Font.Color = vbRed
' -- Autoajustar las cabeceras
.Columns("A:Z").AutoFit
End With
End If
' -- Eliminar las variables de objeto excel
Set obj_hoja = Nothing
Set OBJ_LIBRO = Nothing
Set OBJ_EXCEL = Nothing
' -- Restaurar cursor
Me.MousePointer = vbDefault
Exit Sub
' -- Error
Error_Handler:
MsgBox Err.Description, vbCritical
On Error Resume Next
Set obj_hoja = Nothing
Set OBJ_LIBRO = Nothing
Set OBJ_EXCEL = Nothing
Me.MousePointer = vbDefault
End Sub