将查询从 Access 导出到 Excel 时添加图表

Question

我创建了 4 个对它们进行格式化的查询，并且能够将它们从访问权限导出为 excel 格式。我唯一的问题是 - 如何在 Excel 中导出后将图表添加到我的查询中。我录制了一个宏并在 Access 中复制了 vba 代码，但不幸的是它不起作用。请帮忙。

请注意，这个问题与我在此链接中找到的上一个问题一致： Export and format multiple sheets from Access to Excel

感谢 Evan 迄今为止帮助我。

Answer 1

以下函数摘自 WROX 的《Professional Access 2013 Programming》一书。您应该考虑购买它，因为它会对您有所帮助

Function AccessToExcelChartAutomation()

    Dim rsProducts As Recordset
    Dim wbk As Excel.Workbook
    Dim wks As Excel.Worksheet
    Dim rngCurr As Excel.Range
    Dim rangeChart As Range
    Dim chartNew As Chart

    On Error GoTo Err_AccessToExcelChartAutomation:

    '-- Open a recordset based on the qselProductSalesSummary query.
    Set rsProducts = CurrentDb.OpenRecordset("qselProductSalesSummary")

    '-- Open Excel, then add a workbook, then the first worksheet
    Set appExcel = New Excel.Application
    Set wbk = appExcel.Workbooks.Add
    Set wks = wbk.Worksheets(1)

    '-- In order to see the action!
    appExcel.Visible = True


    With wks
        .Name = "Raw Data"
        '-- Create the Column Headings
        .Cells(1, 1).Value = "Product"
        .Cells(1, 2).Value = "Cost"

        rsProducts.MoveLast
        rsProducts.MoveFirst

        '-- Specify the range to copy data into.
        Set rngCurr = .Range(wks.Cells(2, 1), _
             .Cells(2 + rsProducts.RecordCount, 3))

        rngCurr.CopyFromRecordset rsProducts

        '-- Format the columns
        .Columns("A:B").AutoFit
        .Columns(2).NumberFormat = "$ #,##0"

    End With

    rsProducts.Close
    Set rsProducts = Nothing

    '-- Specify the range to chart
    Set rangeChart = appExcel.ActiveSheet.Range("A:B")

    '== Add a chart to Excel
    Set chartNew = appExcel.Charts.Add

    '-- Create the chart by specifying the chart's source data.
    With chartNew
        .SetSourceData rangeChart
        .ChartType = xl3DColumn
        .Legend.Delete
   End With

   Exit Function

Err_AccessToExcelChartAutomation:

   Beep
   MsgBox "The Following Automation Error has occurred:" & _
                vbCrLf & Err.Description, vbCritical, "Automation Error!"
   Set appExcel = Nothing
   Exit Function

End Function

Answer 2

在您费力创建 VBA 代码以在 excel 中创建图表之前，请考虑在 Access 中创建图表是否可以接受。

本视频将向您展示图表在访问中可以做什么以及如何使用 VBA 来操作它们。

https://www.youtube.com/watch?v=YhgNX6BWWmk

如果您确实需要通过 access 创建 Excel 图表，有多种方法。

一个正在讨论here

我认为这是最能满足您需求的方法。

所有方法都涉及编写引用对象的代码。

上述帖子中的以下函数很有用，因为它可以从访问权限中打开一个已经使用构建图表的代码创建的工作簿，然后它可以运行它们...为您留下一个已打开但已更改的excel工作簿。

哈维

Function RunExcelMacros( _
  ByVal strFileName As String, _
  ParamArray avarMacros()) As Boolean

Debug.Print "xl ini", Time

  On Error GoTo Err_RunExcelMacros

  Static xlApp      As Excel.Application
  Dim xlWkb         As Excel.Workbook

  Dim varMacro      As Variant
  Dim booSuccess    As Boolean
  Dim booTerminate  As Boolean

  If Len(strFileName) = 0 Then
    ' Excel shall be closed.
    booTerminate = True
  End If

  If xlApp Is Nothing Then
    If booTerminate = False Then
      Set xlApp = New Excel.Application
    End If
  ElseIf booTerminate = True Then
    xlApp.Quit
    Set xlApp = Nothing
  End If

  If booTerminate = False Then
    Set xlWkb = xlApp.Workbooks.Open(FileName:=strFileName, UpdateLinks:=0, ReadOnly:=True)

    ' Make Excel visible (for troubleshooting only) or not.
    xlApp.Visible = False 'True

    For Each varMacro In avarMacros()
      If Not Len(varMacro) = 0 Then
  Debug.Print "xl run", Time, varMacro
        booSuccess = xlApp.Run(varMacro)
      End If
    Next varMacro
  Else
    booSuccess = True
  End If

  RunExcelMacros = booSuccess

Exit_RunExcelMacros:

  On Error Resume Next

  If booTerminate = False Then
    xlWkb.Close SaveChanges:=False
    Set xlWkb = Nothing
  End If

Debug.Print "xl end", Time
  Exit Function

Err_RunExcelMacros:
  Select Case Err
    Case 0      'insert Errors you wish to ignore here
      Resume Next
    Case Else   'All other errors will trap
      Beep
      MsgBox "Error: " & Err & ". " & Err.Description, vbCritical +
vbOKOnly, "Error, macro " & varMacro
      Resume Exit_RunExcelMacros
  End Select

End Function