Exportar de Access a Excel, ayuda
Quería hacerte una consulta para exportar de Access a Excel, encontré un código que me ayudo mucho, es el código entregado rodolfo1245, pero necesito hacer unas modificaciones que me tienen un poco complicado. El código es el siguiente:
Private Sub Comando0_Click()
Dim H As Long 'Horizontal
Dim V As Long 'Vertical
Dim MiBase As Database
Dim MiTabla As Recordset
On Error GoTo ErrorExcel
Dim objExcel As Excel.Application
Set MiBase = OpenDatabase("bd1.mdb")
Set MiTabla = MiBase.OpenRecordset("SELECT * FROM Tabla1, tabla2 WHERE tabla1.ID=tabla2.ID_1", dbOpenDynaset)
If MiTabla.RecordCount = 0 Then
MsgBox "La base de datos esta vacia"
Exit Sub
End If
Set objExcel = New Excel.Application
objExcel.Visible = True
objExcel.SheetsInNewWorkbook = 1
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) = "SERVICIO"
.Cells(3, 4) = "CANTIDAD"
.Range(.Cells(3, 1), .Cells(3, 4)).Font.Bold = True
.Columns("D").HorizontalAlignment = xlHAlignRight
.Columns("A").ColumnWidth = 15
.Columns("B").ColumnWidth = 30
.Columns("C").ColumnWidth = 30
.Columns("D").ColumnWidth = 15
End With
objExcel.ActiveSheet.Cells(1, 1) = "Inversión Planta Externa"
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
H = 4
V = 1
Do While Not MiTabla.EOF
DoEvents
objExcel.ActiveSheet.Cells(H, V) = MiTabla.Fields!ID_CLIENTE
objExcel.ActiveSheet.Cells(H, V + 1) = MiTabla.Fields!DIRECCION
objExcel.ActiveSheet.Cells(H, V + 2) = MiTabla.Fields!SERVICIO
objExcel.ActiveSheet.Cells(H, V + 3) = MiTabla.Fields!CANTIDAD
H = H + 1
MiTabla.MoveNext
Loop
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 _
End Sub
Lo que necesito hacer es que exporte solo los datos del formulario activo (no se si me explico muy bien en esto, pero me refiero al formulario con los datos que se están viendo en ese momento).
Además mi base en access tiene 3 tablas donde las relaciones son algo así: Tabla1 con Tabla2 y Tabla1 con Tabla3.
Pude hacer que al exportar lo haga con datos de la tabla1 con tabla2 modificándolo como aparece en el código, pero necesito que en la misma hoja de excel donde me exporto estos datos, haga lo mismo (más abajo en la hoja excel) pero ahora con los datos de la tabla1 con Tabla3.
Espero haber explicado bien el problema y ojala puedas ayudarme.
Private Sub Comando0_Click()
Dim H As Long 'Horizontal
Dim V As Long 'Vertical
Dim MiBase As Database
Dim MiTabla As Recordset
On Error GoTo ErrorExcel
Dim objExcel As Excel.Application
Set MiBase = OpenDatabase("bd1.mdb")
Set MiTabla = MiBase.OpenRecordset("SELECT * FROM Tabla1, tabla2 WHERE tabla1.ID=tabla2.ID_1", dbOpenDynaset)
If MiTabla.RecordCount = 0 Then
MsgBox "La base de datos esta vacia"
Exit Sub
End If
Set objExcel = New Excel.Application
objExcel.Visible = True
objExcel.SheetsInNewWorkbook = 1
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) = "SERVICIO"
.Cells(3, 4) = "CANTIDAD"
.Range(.Cells(3, 1), .Cells(3, 4)).Font.Bold = True
.Columns("D").HorizontalAlignment = xlHAlignRight
.Columns("A").ColumnWidth = 15
.Columns("B").ColumnWidth = 30
.Columns("C").ColumnWidth = 30
.Columns("D").ColumnWidth = 15
End With
objExcel.ActiveSheet.Cells(1, 1) = "Inversión Planta Externa"
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
H = 4
V = 1
Do While Not MiTabla.EOF
DoEvents
objExcel.ActiveSheet.Cells(H, V) = MiTabla.Fields!ID_CLIENTE
objExcel.ActiveSheet.Cells(H, V + 1) = MiTabla.Fields!DIRECCION
objExcel.ActiveSheet.Cells(H, V + 2) = MiTabla.Fields!SERVICIO
objExcel.ActiveSheet.Cells(H, V + 3) = MiTabla.Fields!CANTIDAD
H = H + 1
MiTabla.MoveNext
Loop
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 _
End Sub
Lo que necesito hacer es que exporte solo los datos del formulario activo (no se si me explico muy bien en esto, pero me refiero al formulario con los datos que se están viendo en ese momento).
Además mi base en access tiene 3 tablas donde las relaciones son algo así: Tabla1 con Tabla2 y Tabla1 con Tabla3.
Pude hacer que al exportar lo haga con datos de la tabla1 con tabla2 modificándolo como aparece en el código, pero necesito que en la misma hoja de excel donde me exporto estos datos, haga lo mismo (más abajo en la hoja excel) pero ahora con los datos de la tabla1 con Tabla3.
Espero haber explicado bien el problema y ojala puedas ayudarme.
2 Respuestas
Respuesta de María Celia Ibarra
1
Respuesta de denciso
1