PROGRAMAR EN ACCESS VBA

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