16 may 2011

Extraer SQL en Excel (I)

Esta "extracción de datos" se realizará en un Excel existente (plantilla) a partir del resultado de la SQL que deberá indicarse en el código que se muestra a continuación. En él se indica el número de la celda en la que se debe comenzar a introducir los valores. En este caso, mientras se ejecuta la SQL escribe "Generando datos..." en la celda que corresponde a la fila 8 y columna 5 (wks.Cells(8, 5).Value = "Generando datos..."). Así mismo, indica la ruta donde se guardará el Excel generado con el nombre establecido y la fecha actual (wks.SaveAs ...).
El siguiente código deberá introducirse en el módulo correspondiente (módulos, botón, etc.) y sustituirse los corchetes y su contenido por lo que corresponda.


**********************************************************
'Archivo Nuevo, Escribe Encabezados, abre Consulta Existente e Inserta Datos en hoja.**********************************************************


'Declaración de variables
Dim appExcel, bkExcel, sh1Excel, sh2Excel, rngExcel As Object

'Ejecuta Excel y abre un Archivo Nuevo
Set appExcel = CreateObject("Excel.Application")
appExcel.Visible = True
Set bkExcel = appExcel.Workbooks.Add

'Hoja1..., Escribe Encabezados
Set sh1Excel = bkExcel.Worksheets(1)
sh1Excel.Name = "Visitas x fecha y provincia"
sh1Excel.Cells(1, 1).Value = "Fecha"
sh1Excel.Cells(1, 2).Value = "Tipo"
sh1Excel.Cells(1, 3).Value = "Almería"
sh1Excel.Cells(1, 4).Value = "Cádiz"
sh1Excel.Cells(1, 5).Value = "Córdoba"
sh1Excel.Cells(1, 6).Value = "Granada"
sh1Excel.Cells(1, 7).Value = "Huelva"
sh1Excel.Cells(1, 8).Value = "Jaén"
sh1Excel.Cells(1, 9).Value = "Málaga"
sh1Excel.Cells(1, 10).Value = "Sevilla"
sh1Excel.Cells(1, 11).Value = "Total"
sh1Excel.Cells(2, 1).Value = "Generando datos..."
Set rngExcel = sh1Excel.Range("A2:J1000")

'Abre Consulta Existente
Dim rs1 As DAO.Recordset
Set rs1 = CurrentDb.OpenRecordset("Consulta_hoja1")

'Inserta Datos en Hoja1
If rs1.RecordCount > 0 Then
     Call rngExcel.CopyFromRecordset(rs1, 1000, 11)
End If
rs1.Close


'Hoja2...
Set sh2Excel = bkExcel.Worksheets(2)
'...