Ver Mensaje Individual
  #2 (permalink)  
Antiguo 21/04/2004, 03:30
unholy
 
Fecha de Ingreso: enero-2004
Mensajes: 396
Antigüedad: 20 años, 5 meses
Puntos: 0
Buenas, simplemente copia y pega el codigo que te paso. Has depasar como parametro por referencia un recordset, y la funcion ya hace todo sola, te coje las cabeceras, y te mnonta los campos...

Espero que esto te sea valido....




Public Sub ExportaFacturaExcel(ByRef rs As ADODB.Recordset, NombreDocumento As String)


On Error GoTo err

'Creamos los objetos que necesitaremos para gestionar el documento

Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet

Dim exportFileName As String
Dim i As Long
Dim j As Long
Dim numFilas As Long

'Inicializamos las variables que se encargaran de gestionar las filas
'y columnas del fichero Excel

i = 1
j = 1
numFilas = 0

exportFileName = "c:/RC/Excel/" & NombreDocumento & ".xls"

' Asignamos las referencias a los objetos para inicializarlos

Set xlApp = New Excel.Application
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets.Add

' Asignamos los valores a la hoja de calculo para poder manejarlos

xlApp.DisplayAlerts = False

'Ahora tenemos que movernos por el fichero para cargar los datos que nos
'han pasado por referencia.

'En primer lugar entraremos en un bucle que nos permite
'obtener los nombres de los campos que nos devuelve la sentencia
'sql, y de esta forma establecemos las cabeceras del fichero Excel.

While (numFilas < rs.Fields.Count)

xlSheet.Cells(i, j) = rs.Fields(numFilas).name
j = j + 1
numFilas = numFilas + 1

Wend



'Incrementamos el contador de las filas, para saltar de fila
'y proceder a imprimir los datos del recordset

i = i + 1

While (Not rs.EOF)

j = 0

'Antes de hacer esto y fuera del bucle tenemos que generar las cabeceras.

'Pasaamos a cargar los datos del recordset en la hoja excel

While (j < numFilas)

xlSheet.Cells(i, j + 1).Value = rs(j)

j = j + 1
Wend
i = i + 1
rs.MoveNext

Wend

'Ahora procedemos a guardar la hoja de calculo


xlSheet.SaveAs exportFileName

' Cerramos el libro en el cual guardamos los resultados.

xlBook.Close

' Cerramos la aplicacion Excel

xlApp.Quit

' Release the objects.
Set xlApp = Nothing
Set xlBook = Nothing
Set xlSheet = Nothing

'Dejamos que el sistema realize las operaciones necesarias para
'poder gestionar las facturas

'DoEvents

MsgBox "Fichero generado correctamente"

'Salimos del procedimiento

Exit Sub

'Control de errores

err:

'DEstruimos los objetos que hemos generado


Set xlApp = Nothing
Set xlBook = Nothing
Set xlSheet = Nothing

'Generamos el log correspondiente y devolvemos un error

MsgBox "EL fichero no ha podido ser generado" & vbNewLine & err.Description

End Sub