☰

使用 VBA 将 Access 查询导出到 Excel 并创建次坐标轴图表

tag-icon • tag-icon microsoft-excel vba charts microsoft-access data-transfer
使用 VBA 将 Access 查询导出到 Excel 并创建次坐标轴图表

在 MS Access 中我有一个数据库。我有包含三个文本框和一个命令按钮的表单。

  • 在 txttask_plot 中，用户写入 Plotid
  • 在 txttask_from 中，用户选择 date1
  • 在 txttask_to 中，用户选择 date2

图表在 Sheet1 中，名称为 chart 1。查询在 Sheet2 中，名称为 query。

在命令按钮中，我有以下代码，它将查询导出到 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 Access 命令按钮中使用此类代码？
  • 对于我的图表，我该如何选择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 到 VBA Access。我需要从 MS Access 表单上的命令按钮运行所有代码。

答案1

看来我错了，你可以从外部引用 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

尝试一下，未经测试，只是一个快速破解，也许缺少一些以 结尾的内容等。

相关内容