Cómo rellenar mediante automatización un rango de Excel
Por Enrique Martínez Montejo
Última revisión: 25/09/2004
 

Si no desea utilizar las técnicas que nos ofrece el ISAM de Excel del motor Microsoft Jet, para exportar datos a una hoja cualquiera de un libro de trabajo, podemos utilizar la propia biblioteca de Excel para rellenar un rango de celdas con los datos existentes en un objeto Recordset de ADO.

El proceso de exportación requerirá de un tiempo considerable al tener que ir escribiendo los datos, celda a celda, en el rango especificado. Cuanto mayor sea el número de registros disponibles en el objeto Recordset, mayor será el tiempo necesario para cumplimentar la operación.

El procedimiento que se expone a continuación, obtiene los datos del objeto Recordset pasado en la línea de argumentos, teniendo la posibilidad de guardarlos en un nuevo libro de trabajo. Para ello, opcionalmente puede indicar en el argumento correspondiente, la ruta del libro de trabajo.

Debido al tiempo que puede tardar el procedimiento en realizar la operación, he habilitado el posible uso de un control ProgressBar, el cual indicará el progreso de la operación. Si no desea hacer uso de dicho control, el procedimiento mostrará el puntero del ratón como un reloj de arena, de esta forma le hará saber al usuario que se está realizando la operación de relleno. Por supuesto, si desea implementar el procedimiento en su aplicación, tal y como aparece en el ejemplo, deberá de tener en cuenta que, tanto como si utiliza o no el control ProgressBar, deberá de insertar dicho control en el formulario que llame al procedimiento, porque de lo contrario, obtendrá el oportuno error en tiempo de ejecución.

Antes de intentar ejecutar el ejemplo, establecza una referencia en su proyecto de Visual Basic a las bibliotecas de ADO y Excel que tenga instaladas en su equipo. Asimismo, seleccione el componente Microsoft Windows Common Controls 6.0 e inserte un control ProgressBar en el formulario.

Private Sub RellenarRango(ByVal oRst As ADODB.Recordset, _
                          Optional ByVal strFileName As String, _
                          Optional oProgressBar As ProgressBar)

    ' Declaramos los distintos objetos
    '

    Dim oApp As Excel.Application
    Dim oWorkBook As Excel.Workbook
    Dim oSheet As Excel.Worksheet
    Dim oRange As Excel.Range
    Dim fld As ADODB.Field

    Dim row As Integer, col As Integer, iColumns As Integer
    Dim aVarData() As Variant
    Dim iTypeMouse As Integer

    ' Activamos una rutina de control de errores
    '

    On Error GoTo ErrorRellenarRango

    ' Si el objeto Recordset no se encuentra instanciado, o su
    ' estado es cerrado, salimos del procedimiento
    '

    If (Not (oRst Is Nothing)) Then
        If (oRst.State = adStateClosed) Then Exit Sub
    Else
        Exit Sub
    End If

    ' Guardamos el valor del puntero actual del ratón
    iTypeMouse = Screen.MousePointer

    ' Creamos un nuevo objeto Application
    '

    Set oApp = New Excel.Application

    ' Creamos un nuevo libro de trabajo
    '

    Set oWorkBook = oApp.Workbooks.Add()

    ' Referenciamos la hoja de cálculo actual
    '

    Set oSheet = oWorkBook.Sheets("Hoja1")

    ' Referenciamos un rango para escribir los nombres de los campos
    Set oRange = oSheet.Range("A1:A225")

    ' Escribimos los nombres de las columnas
    '

    For Each fld In oRst.Fields
        iColumns = iColumns + 1
        oRange.Cells(1, iColumns) = fld.Name
    Next

    ' Referenciamos un rango para escribir los valores de los registros,
    ' comenzando en la segunda fila de la hoja de cálculo, ya que la primera
    ' línea contiene el nombre de las columnas
    '

    Set oRange = oSheet.Range("A2:Z8000")

    ' Almacenamos en una matriz los resultados de llamar al método
    ' GetRows del objeto Recordset
    '

    aVarData = oRst.GetRows()

    ' Si se desea utilizar una barra de progreso, configuramos
    ' la misma, en caso contrario, mostramos el puntero del ratón
    ' en forma de reloj de arena, de esta forma indicamos que se
    ' está llevando a cabo la operación
    '

    If (Not (oProgressBar Is Nothing)) Then
        With ProgressBar1
            .Min = 0
            .Max = UBound(aVarData, 2) + 1
        End With
    Else
        Screen.MousePointer = vbHourglass
    End If

    ' Recorresmos los subíndices de la matriz para escribir los valores
    '

    For row = 1 To UBound(aVarData, 2) + 1
        For col = 1 To iColumns
            ' Escribimos el valor del campo
            If (Not (IsNull(aVarData(col - 1, row - 1)))) Then
                oRange.Cells(row, col) = aVarData(col - 1, row - 1)
            End If
        ' Siguiente columna
        Next

        ' Siguiente registro
        If (Not (oProgressBar Is Nothing)) Then oProgressBar.Value = row
    Next

    ' Hacemos visible el libro de trabajo
    oApp.Visible = True

    ' Activamos la hoja de cálculo
    oSheet.Activate

    ' Si no se ha especificado la ruta del archivo de trabajo, abrimos el
    ' cuadro de diálogo Guardar como
    '

    strFileName = oApp.GetSaveAsFilename(strFileName, _
                  "Libro de Microsoft Excel (*.xls), *.xls")

    ' Si se ha cancelado el cuadro de diálogo Guardar como, el método
    ' devolverá Falso/False, dependiendo de la versión de Excel que
    ' se tenga instalada en el equipo
    '

    If ((LCase(strFileName) <> "falso") And (LCase(strFileName) <> "false")) Then
        oWorkBook.SaveAs FileName:=strFileName
    End If

ErrorRellenarRango:

    ' Restauramos la barra de progreso o el puntero del ratón
    '

    If (Not (oProgressBar Is Nothing)) Then
        oProgressBar.Value = 0
    Else
        Screen.MousePointer = iTypeMouse
    End If

    If (Not (oApp Is Nothing)) Then
        If (Not (oWorkBook Is Nothing)) Then
            With oWorkBook
                ' Indicamos que el libro ha sido guardado
                .Saved = True
                ' Cerramos el libro de trabajo
                .Close
            End With
        End If

        ' Cerramos la instancia abierta de Microsoft Excel
        oApp.Quit
    End If

    ' Liberamos las distintas referencias creadas
    '

    Set oRange = Nothing
    Set oSheet = Nothing
    Set oWorkBook = Nothing
    Set oApp = Nothing

End Sub

Para llamar al procedimiento, simplemente tiene que estabecer una conexión con el origen de datos, y abrir un objeto Recordset válido:

Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset

' Establecemos la conexión con el origen de datos
'

Set cnn = New ADODB.Connection
With cnn
    .Provider = "Microsoft.Jet.OLEDB.4.0"
    .ConnectionString = "Data Source=C:\Mis documentos\Neptuno.mdb"
    .Open
End With

' Abrimos un objeto Recordset
'

Set rst = New ADODB.Recordset
rst.Open "SELECT * FROM Clientes", cnn, , , adCmdText

' Rellenamos los datos en la hoja de cálculo
'
RellenarRango rst, "C:\Mis documentos\Libro21.xls", ProgressBar1

' Cerramos el Recordset y la Conexión
'

rst.Close
cnn.Close

 

Otros enlaces de interés:

Trabajar con ADO, DAO y Excel

Indice de Ejemplos de ADO


Enrique Martínez Montejo - 2004

NOTA: La información contenida en este artículo, así como el código fuente incluido en el mismo, se proporciona COMO ESTÁ, sin garantías de ninguna clase, y no otorga derecho alguno. Usted asume cualquier riesgo al poner en práctica, utilizar o ejecutar lo explicado, recomendado o sugerido en el presente artículo.

NOTE: The information contained in this article and source code included therein, is provided AS IS without warranty of any kind, and confers no rights. You assume any risk to implement, use or run it explained, recommended or suggested in this article.