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

Question

我在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$1:$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 

任何人都可以帮助我解决这个难题请。 另外，为了从SAS自动运行任何宏，我总是必须更改Excel选项以“启用所有宏”，我认为这并不好。我看到有人创建并运行宏而没有这样做。你能告诉我如何在Excel中启用所有宏选项来运行宏。

Answer 1

该版本的答案中的代码与以前的版本基本相同。然而，文本已被改写为（1）描述我对这类项目的经验，（2）回答真正的问题，（3）更好地解释解决方案。

我这种类型的项目

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

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

发布Template.xls

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

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

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

行数和列数定义了范围的大小。这些值应该从范围中产生（反之亦然），但这一代并不困难，它的包含会使得答案复杂化很少。

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

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

信封

当该代码被测试，它是一个接入模块内。它可能会转移到一个表单，但尚未经过测试。必须有对“Microsoft Excel 11.0对象库”的引用。

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

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 

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

此代码假定它可以创建SQL statments，将产生准备拖放到工作簿数据的记录集。

此代码已部分测试。测试参数在工作簿中定义了与参数大小相匹配的范围。加载到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