Private Sub AccessExcell_Click()

    Dim H As Long
    Dim V As Long
    Dim MiBase As Database
    Dim MiTabla As Recordset
    
    On Error GoTo ErrorExcel
    
    Dim objExcel As Excel.Application
    
    'Set MiBase = OpenDatabase(CurrentProject.Path & "\db1.mdb")
    'Esta linea anterior, por si deseamos abrir una tabla de cualquier
    'otra MDB. En este ejemplo abrimos una tabla Local (Datos).
    Set MiBase = CurrentDb
    
    Set MiTabla = MiBase.OpenRecordset("SELECT * FROM Datos ORDER BY Nombre ASC", dbOpenDynaset)

    If MiTabla.RecordCount = 0 Then
        MsgBox "La base de datos esta vacia", vbCritical + vbOKOnly, "AVISO"
        Exit Sub
    End If
    
    Set objExcel = New Excel.Application
    objExcel.Visible = True
    'determina el numero de hojas que se mostrara en el Excel
    objExcel.SheetsInNewWorkbook = 1
    'Crea el Libro
    objExcel.Workbooks.Add

    With objExcel.ActiveSheet
        .Range(.Cells(1, 1), .Cells(1, 4)).Borders.LineStyle = xlContinuous
        .Cells(3, 1) = "NOMBRE"
        .Cells(3, 2) = "DIRECCION"
        .Cells(3, 3) = "POBLACION"
        .Cells(3, 4) = "CANTIDAD"
        .Range(.Cells(3, 1), .Cells(3, 4)).Font.Bold = True
        
        .Columns("D").HorizontalAlignment = xlHAlignRight
        .Columns("A").ColumnWidth = 30
        .Columns("B").ColumnWidth = 30
        .Columns("C").ColumnWidth = 30
        .Columns("D").ColumnWidth = 15
    End With
    objExcel.ActiveSheet.Cells(1, 1) = "BASE DE DATOS de ACCESS A EXCEL"
    objExcel.ActiveSheet.Range(objExcel.ActiveSheet.Cells(1, 1), objExcel.ActiveSheet.Cells(1, 4)).HorizontalAlignment = xlHAlignCenterAcrossSelection
    With objExcel.ActiveSheet.Cells(1, 1).Font
        .Color = vbRed
        .Size = 14
        .Bold = True
    End With
    
    V = 4
    H = 1
    Do While Not MiTabla.EOF
        DoEvents
        objExcel.ActiveSheet.Cells(V, H) = MiTabla.Fields!nombre
        objExcel.ActiveSheet.Cells(V, H + 1) = MiTabla.Fields!Direccion
        objExcel.ActiveSheet.Cells(V, H + 2) = MiTabla.Fields!Poblacion
        objExcel.ActiveSheet.Cells(V, H + 3) = MiTabla.Fields!Cantidad
        V = V + 1
        MiTabla.MoveNext
    Loop
    
    V = V + 3
    objExcel.Range(objExcel.Cells(V, 1), objExcel.Cells(V, 4)).Borders.LineStyle = xlContinuous
    objExcel.ActiveSheet.Range(objExcel.ActiveSheet.Cells(V, 1), objExcel.ActiveSheet.Cells(V, 4)).HorizontalAlignment = xlHAlignCenterAcrossSelection
    objExcel.ActiveSheet.Cells(V, 1) = "Francisco Javier García Aguado: Código Web del Programador"
    
    MiBase.Close

    Set objExcel = Nothing
    Exit Sub
    
ErrorExcel:
    MsgBox "Ha ocurrido un error de conexión con Excel." _
    & Chr(13) & Chr(13) & "Error : " & Err.Number _
    & Chr(13) & "Info : " & Err.Description _
    & Chr(13) & "Objeto : " & Err.Source _
    & Chr(13) & Chr(13) & "Revisa las referencias y la ruta de la base de datos. ", vbCritical, "Paco Avisa: Error al conectar con Excel"
  
End Sub