Crear botón exportar en access

Mi problema esta en que quiero crear un botón en un formulario de access para que me exporte las consultas a exel que ya tengo creadas ya que mi jefe necesita trabajar la base en exel, tengo un ejemplo de una base de datos que encontré pero no se como es el procedimiento quisiera enviarle el formulario por la red.

1 respuesta

Respuesta
1
Recién estoy viendo tu pregunta, te armo un ejemplo y te lo envío.
La forma de ralizarlo es aociando al botón que creas para la exportación a excel una función en Visula Basic que lea las tablas a exportar y abra el archivo de excel en el que se desean escribir.
Te anexo un ejemplo, que espero te sea de utilidad, el principio es:
Abrir un archivoExcel
Abrir la Base de datos.
Crear el Query que se desea exportar.
Ejecuat el query
Mientras existna registros
   Escribir en archivo excel.
Cerrar archivo excel
Cerrar consulta.
Fin
Sub ExpAExcel(cadSQL As Variant)
Dim appExcel As Object 'Excel.Application
Dim hoja As Object
Dim con As Connection
Dim rst As Recordset 'DAO.Recordset
Dim fld As Object 'DAO.Field
Dim i As Integer
Dim nom As String
Dim fila As Integer, columna As Integer
Set appExcel = CreateObject("Excel.Application")
Set con = Application.CurrentProject.Connection
' abrimos excel y añadimos un libro nuevo
appExcel.Visible = True
appExcel.Workbooks.Add
' añadimos una hoja nueva por cada consulta que se
' haya pasado como parámetro
Set hoja = appExcel.Sheets.Add
nom = cadSQL
' si el nombre de la consulta es >31 caracteres
' dará error así que lo recortamos
If Len(nom) > 31 Then
nom = Left(nom, 31)
End If
' ... y le damos nombre a la hoja
'hoja.Name = cadSQL
' abrimos un recordset
Set rst = CreateObject("ADODB.RecordSet")
rst.Open cadSQL, con, 1
' ponemos nombre a las columnas de las hojas
' igual que el nombre de los campos del recordset
fila = 10
columna = 1
For Each fld In rst.Fields
hoja.cells(fila, columna) = fld.Name
columna = columna + 1
Next
' después traspasamos el valor de los campos
' a las celdas de la hoja de excel
fila = 10
columna = 1
While Not rst.EOF
For Each fld In rst.Fields
hoja.cells(fila, columna) = fld.Value
columna = columna + 1
Next
columna = 1
fila = fila + 1
rst.MoveNext
Wend
'copiamos algunas variables estaticas en la hoja
hoja.cells(1, 1) = "ESTACION"
hoja.cells(1, 2) = codju.Value
hoja.cells(2, 1) = "FECHA INICIO"
hoja.cells(2, 2) = diaini.Value & "/" & mesini.Value & "/" & añoini.Value
hoja.cells(3, 1) = "FECHA FIN"
hoja.cells(3, 2) = diafin.Value & "/" & mesfin.Value & "/" & añofin.Value
hoja.cells(4, 1) = "NOMBRE"
hoja.cells(4, 2) = nombre.Value
hoja.cells(5, 1) = "CAUCE"
hoja.cells(5, 2) = cauce.Value
hoja.cells(6, 1) = "UNIDADES"
hoja.cells(6, 2) = Texto70.Value
' hoja.cells(5, 4) = codest.Value
'hoja.Cells(5, 3) = OLEIndependiente36
rst.Close
'appExcel.ChartType = EXCEL.XlChartType.xlColumnClustered
If Opción7.Value = False Then
hoja.cells(9, 1) = "ESTACION"
hoja.cells(9, 2) = "PARAMETRO"
hoja.cells(9, 3) = "FECHA TOMA DE MUESTRA"
hoja.cells(9, 4) = "VALOR NUMERICO"
hoja.cells(9, 5) = "VALOR TEXTUAL"
Else
hoja.cells(9, 1) = "FECHA"
hoja.cells(9, 2) = "VALOR"
End If
Dim rango As String
Dim letran As Integer
Dim letra As String
letran = Lista26.ColumnCount
If (letran = 1) Then
letra = "a"
ElseIf (letran = 2) Then
letra = "b"
ElseIf (letran = 3) Then
letra = "c"
ElseIf (letran = 4) Then
letra = "d"
End If
rango = "A1:" & letra & Lista26.ListCount
Dim xlCategory, xlPrimary As Object
'Dim linea As Object
'Set linea = CreateObject("Excel.XlChartType")
'linea = "xlLine"
appExcel.Range(rango).Select
appExcel.Charts.Add
appExcel.ActiveChart.SetSourceData Source:=appExcel.Sheets("Hoja4").Range(rango), PlotBy:=xlColumns
'appExcel.ActiveChart.Location Where:=xlLocationAsObject, Name:="Hoja1"
With appExcel.ActiveChart
appExcel.ActiveChart.HasTitle = True
appExcel.ActiveChart.ChartTitle.Characters.Text = "EVOLUCION DEL PARAMETRO " & Cuadro_combinado30.Value & " " & Texto70.Value & " EN LA ESTACION " & Cuadro_combinado3.Value
'appExcel.ActiveChart.Axes(xlCategory, xlPrimary).HasTitle = True
'appExcel.ActiveChart.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "FECHA"
'appExcel.ActiveChart.Axes(xlValue, xlPrimary).HasTitle = True
'appExcel.ActiveChart.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "VALOR"
End With
appExcel.ActiveChart.HasLegend = False
'appExcel.ActiveChart.ApplyDataLabels Type:=xlDataLabelsShowValue, LegendKey:=False
'appExcel.ActiveChart.ChartType = linea
Set appExcel = Nothing
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas