使用 VBA/宏在 Excel 中创建图形

Creating graph in Excel using VBA/macro

提问by Nupur

I created a macro in Excel for creating bar graphs automatically. Whenever I run it, it gives "smr run time error" and I am not able to figure out what is wrong with my code.

我在 Excel 中创建了一个宏，用于自动创建条形图。每当我运行它时，它都会给出“smr 运行时错误”，我无法弄清楚我的代码有什么问题。

Sub CreateGraph()
'
' CreateGraph Macro
''Initialize variables
Dim lastRow As Integer
Dim xlsPath As String
Dim xlsFile As String
xlsPath = "H:\"
xlsFile = "text.xls"
Workbooks.Open Filename:=xlsPath & xlsFile

    ActiveWindow.SmallScroll Down:=-81
    Range("A1:B" & lastRow).Select
    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.SetSourceData Source:=Range("'TEST'!$A:$B" & lastRow)
    ActiveChart.ChartType = xlBarClustered
    ActiveChart.Axes(xlCategory).Select
    ActiveSheet.ChartObjects("Chart 2").Activate
    ActiveChart.Axes(xlCategory).ReversePlotOrder = True
    Range("Q111").Select
    ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub

Can anyone help me in solving this puzzle please. Also for running any macro automatically from SAS, I always have to change the Excel options for "enable all macros" which I suppose is not good. I have seen people creating and running macros without doing this. Can you please tell me how can I run the macros with enabling all macros option in Excel.

谁能帮我解决这个难题。同样为了从 SAS 自动运行任何宏，我总是必须更改“启用所有宏”的 Excel 选项，我认为这并不好。我见过有人在不这样做的情况下创建和运行宏。你能告诉我如何在 Excel 中启用所有宏选项来运行宏。

回答by Tony Dallimore

The code within this version of the answer is essentially unchanged from the previous version. However, the text has been rewritten to (1) describe my experience of this type of project, (2) answer the true question and (3) better explain the solution.

此版本答案中的代码与先前版本基本相同。但是，文本已被重写为 (1) 描述我在此类项目中的经验，(2) 回答真正的问题，以及 (3) 更好地解释解决方案。

My experience of this type of project

我对此类项目的经验

I have been involved in five such projects. In each case, the client believed they required the automatic creation of charts but detailed discussion revealed that that this was not the requirement. The clients all published a substantial number of charts per month but most of the charts were the same as last month but with new data. They needed to automate the provision of new data for the charts. Every month some charts were revised but this was humans agreeing better ways of presenting the data. They wanted the 90% of charts that were unchanged to go through without any effort and implementation of the revisions to be as easy as possible.

我参与了五个这样的项目。在每种情况下，客户都认为他们需要自动创建图表，但详细讨论表明这不是要求。客户每个月都发布了大量图表，但大多数图表与上个月相同，但有新的数据。他们需要自动为图表提供新数据。每个月都会修改一些图表，但这是人类同意更好的数据呈现方式。他们希望 90% 的图表无需任何努力即可完成，并且修订版的实施尽可能简单。

In this case, the questioner publishes 100 charts per month in the form of an Excel workbook. The data for these charts comes from an Access database. The solution allows for the charts to be changed easily but this is to ease the programming and not to provide more than has been requested.

在这种情况下，提问者每月以 Excel 工作簿的形式发布 100 个图表。这些图表的数据来自 Access 数据库。该解决方案允许轻松更改图表，但这是为了简化编程，而不是提供超出要求的内容。

Release Template.xls

发布模板.xls

The solution requires a hand-crafted workbook named Release Template.xls. This workbook will contain all the charts and the Month 1 data. The solution creates a copy of this workbook named Release YYMM.xls in which the Month 1 data has been overwritten by the MM/YY data.

该解决方案需要一个名为 Release Template.xls 的手工工作簿。该工作簿将包含所有图表和第 1 个月的数据。该解决方案创建了一份名为 Release YYMM.xls 的工作簿副本，其中第 1 个月的数据已被 MM/YY 数据覆盖。

Release Template.xls contains a worksheet, Params, which will be deleted from the release version. This worksheet has a title row and one data row per chart. There are five columns: Sheet Name, Range, Number of Rows, Number of Columns and SQL command.

Release Template.xls 包含一个工作表 Params，它将从发布版本中删除。此工作表的每个图表有一个标题行和一个数据行。有五列：工作表名称、范围、行数、列数和 SQL 命令。

Sheet Name and Range define the location of the source data for the chart.

工作表名称和范围定义图表源数据的位置。

Number of Rows and Number of Columns define the size of the range. These values should be generated from the range (or vice versa) but this generation is not difficult and its inclusion would complicate the answer for little advantage.

行数和列数定义了范围的大小。这些值应该从范围中生成（反之亦然），但这一生成并不困难，而且它的包含会使答案复杂化，几乎没有什么好处。

SQL command is the command to be used to extract the data for the chart from the database. The code below assumes the SQL command generates a Recordset containing data ready to drop into the worksheet.

SQL 命令是用于从数据库中提取图表数据的命令。下面的代码假设 SQL 命令生成一个包含准备放入工作表的数据的 Recordset。

These parameters could be in the Access database but I believe they fit more logically in the workbook. These parameters control getting data out of the Access database and into the Excel workbook. If a chart is changed such that it requires new data, these parameters must be changed to match but no change is required to the code.

这些参数可能在 Access 数据库中，但我相信它们在工作簿中更符合逻辑。这些参数控制从 Access 数据库和 Excel 工作簿中获取数据。如果图表发生更改，需要新数据，则必须更改这些参数以匹配，但无需更改代码。

Envelope

信封

When this code was tested, it was within an Access Module. It could probably be transferred to a form but that has not been tested. There MUST be a reference to the "Microsoft Excel 11.0 Object Library".

测试此代码时，它位于访问模块中。它可能可以转移到一种形式，但尚未经过测试。必须有对“Microsoft Excel 11.0 对象库”的引用。

This envelope should be suitable for any similar problem.

这个信封应该适用于任何类似的问题。

Option Compare Database
Option Explicit

Sub Control()

  ' This list includes the variables for the envelope and the generation code

  Dim DestFileName As String
  Dim Path As String
  Dim xlApp As Excel.Application
  Dim xlWB As Excel.Workbook

  ' I have my Excel file and my Access database in the same folder.
  ' This statement gets me the name of the folder holding my database.
  ' You may need to define a different path.
  Path = Application.CurrentProject.Path

  ' Create path and file name of "Resource YYMM.xls"
  DestFileName = Path & "\" & "Resource " & Format(Date, "yymm") & ".xls"
  ' Create copy of "Resource Template.xls".
  FileCopy Path & "\Resource Template.xls", DestFileName

  Set xlApp = New Excel.Application
  With xlApp
    .Visible = True  ' This slows the macro but helps with debugging
    ' .Visible = False
    Set xlWB = .Workbooks.Open(DestFileName)
    With xlWB      

      ' Code to amend "Resource YYMM.xls" goes here

      .Save       ' Save the amended workbook
      .Close      ' Close the amended workbook
    End With
    Set xlWB = Nothing  ' Clear reference to workbook
    .Quit               ' Quit Excel
  End With   Set xlApp = Nothing   ' Clear reference to Excel
End Sub

Code to generate copy data to workbook

生成复制数据到工作簿的代码

This code assumes it is possible to create SQL statments that will generate Recordsets of data ready to drop into the workbook.

此代码假定可以创建 SQL 语句，这些语句将生成准备放入工作簿的数据记录集。

This code has been partially tested. The tests parameters defined ranges in the workbook which matches the size of the parameters. The data loaded into Params() was written to these ranges.

此代码已部分测试。测试参数在工作簿中定义了与参数大小相匹配的范围。加载到 Params() 的数据被写入这些范围。

      Dim DestSheetName As String
      Dim NumCols As Integer
      Dim NumRows As Integer
      Dim OutData() as Variant
      Dim Params() as Variant
      Dim RngDest As String
      Dim RowParamCrnt As Integer
      Dim RowParamMax As Integer
      Dim SQLCommand As String

      With .Sheets("Params")
        ' Find last used row in worksheet
        RowParamMax = .Cells(Rows.Count,"A").End(xlUp).Row
        ' Read entire worksheet into array Params
        Params = .Range(.Cells(1, 1), .Cells(RowParamMax, 5)).Value

        xlApp.DisplayAlerts = False       ' Surpress delete confirmation
        .Delete                           ' Delete parameters sheet
        xlApp.DisplayAlerts = True

      End With    

      ' Params is an array with two dimensions.  Dimension 1 is the row.
      ' Dimension 2 is the column.  Loading Params from the range is
      ' equivalent to:
      '   ReDim Params( 1 to RowParamMax, 1 to 5)    
      '   Copy data from worksheet to array

      For RowParamCrnt = 2 To RowParamMax

        DestSheetName = Params(RowParamCrnt, 1)
        DestRng = Params(RowParamCrnt, 2)
        NumRows = Params(RowParamCrnt, 3)
        NumCols = Params(RowParamCrnt, 4)
        SQLCommand = Params(RowParamCrnt, 5)

        ' Use the SQL command to create a Recordset containing the data
        ' for the chart. 

        ' Check the Recordset's dimensions against NumRows and NumCols

        ReDim OutData(1 to NumRows, 1 to NumCols)

        ' Note (repeat Note): the first dimension is for rows and the
        ' second dimension is for columns. This is required for arrays
        ' to be read from or to a worksheet.

        ' Move the data out of the Recordset into array OutData.

        .Sheets(DestSheetName).Range(DestRng).Value = OutData

      Next