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

时间:2015-07-27 14:53:56

标签: ms-access

我创建了4个格式化的查询,并能够从访问excel格式导出它们。我唯一的问题是 - 在Excel中导出后,如何为查询添加图表。我录制了一个宏并在Access中复制了vba代码,但不幸的是它没有用。请帮忙。

请注意,此问题与我之前在此链接中找到的问题相符: Export and format multiple sheets from Access to Excel

感谢Evan到目前为止帮助我。

2 个答案:

答案 0 :(得分:0)

在您经历相当麻烦的创建VBA代码以在Excel中创建图表之前,请考虑是否可以在Access中创建图表。

此视频将向您展示图表在访问中可以执行的操作以及如何使用VBA来操作它们。

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

如果您确实需要通过访问创建Excel图表,则可以使用多种方法。

讨论了here

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

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

以上帖子中的以下函数很有用,因为它可以从访问中使用,打开一个工作簿,该工作簿已经使用构建图表的代码创建,然后可以运行它们...让你打开但是打开excel workbook。

哈维

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

答案 1 :(得分:0)

以下功能取自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