Visual Basic 6.0 - Exportar DataGrid a Excel

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.