Exportar contenido de un DataGrid a un archivo de Excel
Como estan, este post como muchos otros que cuelgo estan echos con la finalidad de compartir informacion sobre la programacion en Visual Basic 6.0. En esta oportunidad les paso el codigo de como exportar el contenido de un DataGrid (previamente cargado con un recordset) a un archivo de excel paso a paso.
Paso 1: Crear una base de datos de prueba (en este caso utilizaremos access) con una tabla en este caso yo llamare
a mi base de datos "PRUEBA" y a mi tabla "TABARTICULOS". La tabla podra tener cuantos campos quieran
Nota: La coneccion a la base de datos no es el tema principal realmente el tipo de coneccion no influye en lo que se esta tratando en este post pero si quieren aprender pasen por este post.(reparando enlace)
Paso 2: Abrir un nuevo proyecto de Visual Basic 6.0.
Paso 3: Agregar las referencias de ado para el proyecto, Menu ProyectoReferencias y en el cuadro de dialogo ubicar y seleccionar "Microsoft ActiveX Data Objects 2.0 Library" (en el caso de conecciones sencillas es el mas recomendable) y ubicar y seleccionar con un check "Microsoft Excel 11.0 Object Library" para poder exportar.
Paso 4: Agregar los componentes no predeterminados nesesarios desde la biblioteca de componentes Menu ProyectoComponentes y en el cuadro de dialogo ubicar y seleccionar con un check "Microsoft
DataGrid Control 6.0 (SP6) (OLEDB)".
Paso 5: Agegar un DataGrid al Formulario con dos CommandButton
Nota: al DataGrid lo llamare dgExportar, a los CommandButton cmdCargar y cmdExportar respectivamente
Paso 6: Agregar un Modulo .bas al proyecto
Ahora el codigo:
Esto en el modulo (es la manera de conectar mediante DSN)
'VARIABLES DE CONECCION
Public coneccion As New Connection
Public rstFacturas As New Recordset
'LA CONECCION
Public Sub Conneccion()
Set Module1.coneccion = New Connection
Module1.coneccion.CursorLocation = adUseClient
End Sub
'LA FUNCION QUE CARGA LA TABLA EN EL DATAGRID
Public Sub Fun_rstFacturas(Grid As DataGrid)
Set rstFacturas = New Recordset
rstFacturas.Open "select * from TABARTICULOS", coneccion, adOpenStatic, adLockOptimistic
Set Grid.DataSource = rstFacturas
End Sub
Para cargar la tabla en el DataGrid:
Private Sub cmdCargar_Click()
Call Conneccion
coneccion.Open "DSN=PRUEBA;database=PRUEBA"
Call Fun_rstFacturas(Me.dgExportar)
End Sub
'Ahora para exportar
Private Sub cmdExportar_Click()
On Error GoTo ErrorExcel
Dim objExcel As Excel.Application
Dim HNom As Integer 'Horizontal
Dim VNom As Integer 'Vertical
Dim Hdatos As Integer 'Horizontal
Dim Vdatos As Integer 'Vertical
Dim cuentaNombres As Integer
Dim cuentadatos As Integer
Dim i As Integer
Dim n As Integer
Dim j As Integer
If rstFacturas.RecordCount <> 0 Then
'Crear un objeto del tipo excel.application
Set objExcel = New Excel.Application
objExcel.Visible = True
objExcel.SheetsInNewWorkbook = 1
objExcel.Workbooks.Add
'PONER UN TITULO
objExcel.ActiveSheet.Cells(1, 1) = "EJEMPLO DE EXPORTAR A EXCEL"
With objExcel.ActiveSheet.Cells(1, 1).Font
.Color = vbBlack
.Size = 9
.Bold = True
End With
'AHORA UN SUBTITULO
objExcel.ActiveSheet.Cells(3, 1) = "CONSULTA DE ARTICULOS"
With objExcel.ActiveSheet.Cells(3, 1).Font
.Color = vbBlack
.Size = 9
.Bold = True
End With
'UTILIZAMOS LAS VARIABLES PARA LA UBICACION DE NUESTROS TEXTOS
HNom = 1
VNom = 7
Vdatos = 8
Hdatos = 1
cuentaNombres = rstFacturas.Fields.Count
cuentadatos = rstFacturas.RecordCount
'AGREGAMOS LOS REGISTROS (RECUERDEN QUE NO IMPORTA CUANTAS COLUMNAS O REGISTROS TENGAMOS EL BUCLE_
'FUNCIONA SEGUN EL NUMERO DE CABECERAS Y REGISTROS
For i = 0 To (cuentaNombres - 1)
objExcel.ActiveSheet.Cells(VNom, HNom) = Me.dgExportar.Columns(i).Caption 'rstFacturas.Fields(i).Name
objExcel.ActiveSheet.Range(objExcel.ActiveSheet.Cells(VNom, HNom), objExcel.ActiveSheet.Cells(VNom, HNom)).HorizontalAlignment = xlHAlignCenterAcrossSelection
With objExcel.ActiveSheet.Cells(VNom, HNom).Font
.Size = 9
.Color = vbRed
.Bold = True
End With
rstFacturas.MoveFirst
For n = 1 To rstFacturas.RecordCount
objExcel.ActiveSheet.Cells(Vdatos, Hdatos) = rstFacturas.Fields(i).Value
objExcel.ActiveSheet.Cells(Vdatos, Hdatos).Font.Size = 8
Vdatos = Vdatos + 1
rstFacturas.MoveNext
Next
HNom = HNom + 1
Hdatos = Hdatos + 1
Vdatos = 8
rstFacturas.MoveFirst
Next i
'AHORA LE ASIGNAMOS UN TAMAÑO A CADA COLUMNA SEGUN NESECITEMOS
objExcel.Columns( "B" ).ColumnWidth = 19.43
objExcel.Columns( "C" ).ColumnWidth = 19.43
objExcel.Columns( "D" ).ColumnWidth = 16.86
objExcel.Columns( "E" ).ColumnWidth = 10.83
End If
Exit Sub
ErrorExcel:
MsgBox Err.Description
End Sub
Cabe mencionar que este ejemplo puede ser utilizado cuando no dispongamos de Crystal Reports o tengamos algun problema al imprimir por esta misma via.