Создание графика в Excel с использованием VBA / macro - PullRequest
0 голосов
/ 01 декабря 2011

Я создал макрос в 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.

1 Ответ

2 голосов
/ 01 декабря 2011

Код в этой версии ответа практически не отличается от предыдущей версии.Тем не менее, текст был переписан, чтобы (1) описать мой опыт такого типа проектов, (2) ответить на истинный вопрос и (3) лучше объяснить решение.

Мой опыт такого типапроекта

Я участвовал в пяти таких проектах.В каждом случае клиент полагал, что ему требуется автоматическое создание диаграмм, но подробное обсуждение показало, что это не является обязательным требованием.Все клиенты публиковали значительное количество графиков в месяц, но большинство графиков были такими же, как в прошлом месяце, но с новыми данными.Им нужно было автоматизировать предоставление новых данных для графиков.Каждый месяц некоторые графики пересматривались, но люди соглашались с лучшими способами представления данных.Они хотели, чтобы 90% графиков, которые были неизменными, проходили без каких-либо усилий, и внедрение изменений было как можно более простым.

В этом случае спрашивающий публикует 100 диаграмм в месяц в форме рабочей книги Excel.Данные для этих диаграмм поступают из базы данных Access.Решение позволяет легко изменять диаграммы, но это облегчает программирование и не обеспечивает больше, чем было запрошено.

Release Template.xls

Решение требует ручной книги под названием Release Template.xls.Эта рабочая тетрадь будет содержать все графики и данные за первый месяц.Решение создает копию этой рабочей книги с именем Release YYMM.xls, в которой данные за месяц были перезаписаны данными MM / YY.

Release Template.xls содержит лист Params, который будет удален изверсия выпуска.Этот рабочий лист имеет строку заголовка и одну строку данных на диаграмму.Существует пять столбцов: Имя листа, Диапазон, Количество строк, Количество столбцов и Команда SQL.

Имя листа и Диапазон определяют местоположение исходных данных для диаграммы.

КоличествоRows и Number of Columns определяют размер диапазона.Эти значения должны быть сгенерированы из диапазона (или наоборот), но это поколение не сложно, и его включение усложнит ответ для небольшого преимущества.

Команда SQL - это команда, используемая для извлечения данных дляграфик из базы данных.В приведенном ниже коде предполагается, что команда SQL создает набор записей, содержащий данные, готовые для перетаскивания на лист.

Эти параметры могут быть в базе данных 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-утверждения, которые будут генерировать наборы записей данных, готовых для переноса в рабочую книгу.

Этот код был частично протестирован.Определенные параметры тестов находятся в рабочей таблице, которая соответствует размеру параметров.Данные, загруженные в 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
...