Експорт запиту доступу до Excel за допомогою VBA та створення діаграми вторинної осі

У MS Access у мене є база даних. У мене форма з трьома TextBoxes і однією кнопкою Command.

• У txttask_plot користувач пише Plotid
• У txttask_від користувача вибирається дата1
• У txttask_to користувач вибирає дату2

Діаграма представлена ​​в таблиці 1 із назвою діаграми 1. Запит знаходиться на аркуші2 з назвою запиту.

У кнопці Command у мене є наступний код, який експортує запит до Excel та графікує всі дані на графіку 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

Звідси я використовую весь код в Excel.

• Як я можу використовувати такий код у кнопці командного доступу MS?
• Як я можу вибрати свій графік Range("C2:D" & i-1)?
• Як додати вторинну вісь y?
• Як додати головний заголовок та як додати підзаголовок під основний заголовок?

Другий набір значень (x, y) - це (завдання, вартість) має діапазон від 18 000 до "n", який я хочу на вторинній осі y.

Також мені потрібно вставити первинний заголовок зверху та вторинний заголовок внизу

У мене є цей код для назв

'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

Мітки діаграм

'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

Я довго шукав в Інтернеті, але не можу досить покласти пальцем на правильний синтаксис: VBA Excel to VBA Access. Мені потрібно запустити весь код з кнопки Command у формі доступу MS.

Здається, я помилявся, і ви можете посилатися на об’єкти ActiveSth ззовні.

Цей код потребує посилання на Microsoft Excel xy.0 Object Libaryта Microsoft Office xy.0 Object Libaryв "VBA-редактор -> Інструменти -> Посилання" або визначає явні перерахунки Excel (наприклад, 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

Спробуйте це, не перевірено, просто швидкий злом, можливо, якийсь кінець з тощо не вистачає.