![使用 VBA 将 Access 查询导出到 Excel 并创建次坐标轴图表](https://linux22.com/image/1568729/%E4%BD%BF%E7%94%A8%20VBA%20%E5%B0%86%20Access%20%E6%9F%A5%E8%AF%A2%E5%AF%BC%E5%87%BA%E5%88%B0%20Excel%20%E5%B9%B6%E5%88%9B%E5%BB%BA%E6%AC%A1%E5%9D%90%E6%A0%87%E8%BD%B4%E5%9B%BE%E8%A1%A8.png)
在 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
尝试一下,未经测试,只是一个快速破解,也许缺少一些以 结尾的内容等。