Exportando a consulta do Access para o Excel usando o VBA e criando um gráfico de eixo secundário

Question

No MS Access eu tenho um banco de dados. Eu tenho o formulário com três TextBoxes e um botão de comando.

• No usuário txttask_plot, você escreve Plotid
• Em txttask_from, o usuário seleciona date1
• Em txttask_para o usuário seleciona data2

O gráfico está na Folha1 com o nome do gráfico 1. A consulta está na sheet2 com o nome da consulta.

No botão de comando, tenho o seguinte código que exporta uma consulta para o Excel e grava todos os dados em um gráfico xlColumnStacked.

Sub cmdTransfer_Click()
    Dim sExcelWB As String
    Dim xl As Object ''Excel.Application
    Dim wb As Object ''Excel.Workbook
    Dim ws As Object ''Excel.Worksheet
    Dim ch As Object ''Excel.Chart
    Dim myRange As Object

    Set xl = CreateObject("excel.application")
    sExcelWB = "D:\testing2\" & "_qry_task.xls"
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "qry_mb_costo_jorn_tarea", sExcelWB, True
    Set wb = xl.Workbooks.Open(sExcelWB)

    'Sheets are named with the Access query name
    Set ws = wb.Sheets("qry_task")

    Set ch = xl.Charts.Add
    ch.ChartType = xlColumnClustered

    xl.Visible = True
    xl.UserControl = True
End Sub

A partir daqui, estou usando todo o código no Excel.

• Como posso usar esse código no Botão de Comando do MS Access?
• Para meu gráfico, como posso selecionar Range("C2:D" & i-1) ?
• Como eu adiciono um eixo y secundário?
• Como adicionar o título principal e como adicionar uma legenda abaixo do título principal?

O segundo conjunto de valores (x, y) é (tarefa, custo) tem um intervalo de > 18.000 para "n" que eu quero no eixo y secundário.

Além disso, preciso inserir um título principal no topo e um título secundário abaixo

Eu tenho este código para títulos

'Main Title from sheet "qry_task" in top of the Chart
    .HasTitle = True
    .ChartTitle.Text = Range("A1").Value & " " & Range("A2").Value & " " & Range("D1").Value
    .Axes(xlValue).MajorGridlines.Delete
    .Axes(xlCategory, xlPrimary).HasTitle = False
    .Axes(xlValue, xlPrimary).HasTitle = False

'SubTitle below First Title from Sheet qry_task
From txtboxes from the Form.
(txt_from – txt_to)

'chart_position_upper_left_corner Macro
With ActiveSheet.Shapes("Chart 1")
    .Left = Range("A1").Left
    .Top = Range("A1").Top
End With

ActiveSheet.Shapes("Chart1").IncrementLeft -375.75
ActiveSheet.Shapes("Chart 1").IncrementTop -96
ActiveSheet.Shapes("Chart 1").ScaleWidth 1.3354166667, msoFalse, _
    msoScaleFromTopLeft
ActiveSheet.Shapes("Chart 1").ScaleHeight 1.3177085156, msoFalse, _
    msoScaleFromTopLeft

'insert secundary axis()   
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.PlotArea.Select
ActiveChart.FullSeriesCollection(2).Select
ActiveChart.FullSeriesCollection(2).AxisGroup = 2
ActiveChart.FullSeriesCollection(2).Select
ActiveChart.FullSeriesCollection(2).ChartType = xlLineMarkers
ActiveChart.FullSeriesCollection(1).Select
ActiveChart.ChartGroups(1).GapWidth = 69
ActiveChart.FullSeriesCollection(2).Select
Application.CommandBars("Format Object").Visible = False
ActiveSheet.Shapes("Chart 1").ScaleWidth 1.5180265655, msoFalse, _
    msoScaleFromTopLeft

marcadores de gráficos

'Chart labels
ActiveSheet.Shapes("Chart 1").ScaleHeight 1.1797101449, msoFalse, _
    msoScaleFromTopLeft
ActiveChart.FullSeriesCollection(2).Select
ActiveChart.ChartGroups(1).GapWidth = 48
ActiveChart.FullSeriesCollection(1).Select
ActiveChart.SetElement (msoElementDataLabelShow)
ActiveChart.SetElement (msoElementDataLabelInsideBase)
ActiveChart.FullSeriesCollection(1).DataLabels.Select

With Selection.Format.TextFrame2.TextRange.Font.Fill
    .Visible = msoTrue
    .ForeColor.ObjectThemeColor = msoThemeColorBackground1
    .ForeColor.TintAndShade = 0
    .ForeColor.Brightness = 0
    .Transparency = 0
    .Solid
End With

'Edit Font
Selection.Format.TextFrame2.TextRange.Font.Bold = msoTrue

With Selection.Format.TextFrame2.TextRange.Font
    .NameComplexScript = "Arial"
    .NameFarEast = "Arial"
    .Name = "Arial"
End With
End Sub

Eu pesquisei na Web por um bom tempo, mas não consegui identificar exatamente a sintaxe correta: VBA Excel para acesso ao VBA. Eu preciso executar todo o código do botão de comando no formulário do MS Access.

    

Answer 1

Parece que eu estava errado e você pode se referir a objetos ActiveSth de fora.

Este código precisa de uma referência a Microsoft Excel xy.0 Object Libary e Microsoft Office xy.0 Object Libary em "Editor VBA - > Ferramentas - > Referências" ou definir as enumerações do Excel como explícitas (por exemplo, xlLineMarkers)

Sub cmdTransfer_Click()
Dim sExcelWB As String
Dim xl As Object ''Excel.Application
Dim wb As Object ''Excel.Workbook
Dim ws As Object ''Excel.Worksheet
Dim ch As Object ''Excel.Chart
Dim myRange As Object

Set xl = CreateObject("excel.application")
sExcelWB = "D:\testing2\" & "_qry_task.xls"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "qry_task", sExcelWB, True
Set wb = xl.Workbooks.Open(sExcelWB)

'Sheets are named with the Access query name
Set ws = wb.Sheets("qry_task")

Set ch = xl.Charts.Add
ch.ChartType = xlColumnClustered
with ch
    'Main Title from sheet "qry_task" in top of the Chart
    .HasTitle = True
    .ChartTitle.Text = ws.Range("A1").Value & " " & ws.Range("A2").Value & " " & ws.Range("D1").Value
    .Axes(xlValue).MajorGridlines.Delete
    .Axes(xlCategory, xlPrimary).HasTitle = False
    .Axes(xlValue, xlPrimary).HasTitle = False
End With
'SubTitle below First Title from Sheet qry_task
'From txtboxes from the Form.
'(txt_from – txt_to)

'chart_position_upper_left_corner Macro
With wb
    .ActiveSheet.Shapes("Chart 1")
    .Left = .Range("A1").Left
    .Top = .Range("A1").Top


.ActiveSheet.Shapes("Chart1").IncrementLeft -375.75
.ActiveSheet.Shapes("Chart 1").IncrementTop -96
.ActiveSheet.Shapes("Chart 1").ScaleWidth 1.3354166667, msoFalse, _
    msoScaleFromTopLeft
.ActiveSheet.Shapes("Chart 1").ScaleHeight 1.3177085156, msoFalse, _
    msoScaleFromTopLeft

'insert secundary axis()   
.ActiveSheet.ChartObjects("Chart 1").Activate
.ActiveChart.PlotArea.Select
.ActiveChart.FullSeriesCollection(2).Select
.ActiveChart.FullSeriesCollection(2).AxisGroup = 2
.ActiveChart.FullSeriesCollection(2).Select
.ActiveChart.FullSeriesCollection(2).ChartType = xlLineMarkers
.ActiveChart.FullSeriesCollection(1).Select
.ActiveChart.ChartGroups(1).GapWidth = 69
.ActiveChart.FullSeriesCollection(2).Select
.Application.CommandBars("Format Object").Visible = False
.ActiveSheet.Shapes("Chart 1").ScaleWidth 1.5180265655, msoFalse, _
    msoScaleFromTopLeft
'Chart labels

'Chart labels
.ActiveSheet.Shapes("Chart 1").ScaleHeight 1.1797101449, msoFalse, _
    msoScaleFromTopLeft
.ActiveChart.FullSeriesCollection(2).Select
.ActiveChart.ChartGroups(1).GapWidth = 48
.ActiveChart.FullSeriesCollection(1).Select
.ActiveChart.SetElement (msoElementDataLabelShow)
.ActiveChart.SetElement (msoElementDataLabelInsideBase)


With wb.ActiveChart.FullSeriesCollection(1).DataLabels.Format.TextFrame2.TextRange.Font.Fill
    .Visible = msoTrue
    .ForeColor.ObjectThemeColor = msoThemeColorBackground1
    .ForeColor.TintAndShade = 0
    .ForeColor.Brightness = 0
    .Transparency = 0
    .Solid


'Edit Font
.Format.TextFrame2.TextRange.Font.Bold = msoTrue

With .Format.TextFrame2.TextRange.Font
    .NameComplexScript = "Arial"
    .NameFarEast = "Arial"
    .Name = "Arial"
End With
End With
End Sub

Tente isto, não testado, apenas um hack rápido, talvez algum fim com, etc estão faltando.