Visual Basic - Pasar un Recordset a Excel

Esto es una función, que le pasais, un Recorset Ado, un Spreadsheet (ahora lo defino), una Barra de progreso y un Label (para mostrar las cantidades) y pasara todo el recorset a un Excel

Spreadsheet es un control, es un libro Excel en si. Para utilizarlo, en componentes, añadis Microsoft Office Web Components. Os aparecera una serie de controles de Office, pues agregais al Formulario el de Excel.

¡Pues no necesitais mas! Aqui esta la función

Function RellenaExcel(Rs As ADODB.Recordset, ByRef Excel As Spreadsheet, ByRef Barra As ProgressBar, MostrarCantidades As Label) As Boolean

Dim Max As Integer
Dim Fila As Integer


Barra.Min = 0
Barra.Value = 0
If Rs.RecordCount <> 0 Then
Barra.Max = Rs.RecordCount
MostrarCantidades.Caption = "0 / " + Str(Barra.Max)
Else
MsgBox "El resultado de la consulta no contiene datos.", vbExclamation
Exit Function
End If
Max = Rs.Fields.Count - 1

For i = 0 To Max
Excel.ActiveSheet.Cells(1, i + 1).Value = Rs(i).Name
Next i


Fila = 2
Barra.Value = 1
MostrarCantidades.Caption = "1 / " + Str(Barra.Max)

While Not Rs.EOF

For i = 0 To Max
Excel.ActiveSheet.Cells(Fila, i + 1).Value = Rs(i).Value
Next i

Barra.Value = Fila - 1
DoEvents
MostrarCantidades.Caption = Str(Barra.Value) + " / " + Str(Barra.Max)
Fila = Fila + 1
Rs.MoveNext

Wend


With Excel.ActiveSheet.Range(Excel.Cells(1, 1), Excel.ActiveSheet.Cells(1, Max + 1))
.Font.Bold = True
.Font.Size = 10
.Font.Name = "Arial"
.Font.Color = vbWhite
'.Borders.Color = vbGreen
.Interior.Color = RGB(0, 0, 128)
.Borders.Color = RGB(0, 0, 0)

End With
With Excel.ActiveSheet.Range(Excel.Cells(2, 1), Excel.ActiveSheet.Cells(Fila - 1, Max + 1)).Font
.Size = 9
'.Bold = True
.Name = "Arial"
End With

Set rango = Excel.Worksheets("Hoja1").Range("A1:BV" + Trim(Fila + 1))
rango.Columns.AutoFit

RellenaExcel = True



End Function