1

Тема: Разбор примера Microsoft о работе с массивами в Excel

Приведенный в настоящем примере макрос открывает новую книгу (новый файл), формирует таблицу, открывает новый лист и выводит по данным таблицы диаграмму.
Статья опубликована на сайте support.microsoft.com/kb по адресу:
внешняя ссылка

В настоящей публикации мы даем комментарии на русском языке к основным блокам и операторам указанного примера.

Примечание – Данный макрос может исполняться с ошибкой в строке:
.SeriesCollection(iRet).Name = "=""Q" & Str(iRet) & """"


Private Sub Command1_Click()
      Dim oXL As Excel.Application
      Dim oWB As Excel.Workbook
      Dim oSheet As Excel.Worksheet
      Dim oRng As Excel.Range

      'On Error GoTo Err_Handler
      
   ' Открыть новую книгу (новый файл) Excel (Start Excel and get Application object).
      Set oXL = CreateObject("Excel.Application")
      oXL.Visible = True
      
   ' Открыть новую книгу.
      Set oWB = oXL.Workbooks.Add
      Set oSheet = oWB.ActiveSheet
      
   ' Добавляет заголовки таблицы (шапку).
      oSheet.Cells(1, 1).Value = "First Name"
      oSheet.Cells(1, 2).Value = "Last Name"
      oSheet.Cells(1, 3).Value = "Full Name"
      oSheet.Cells(1, 4).Value = "Salary"

   ' Выделить шапку жирным шрифтом и центрировать шапку (Format A1:D1 as bold, vertical alignment = center).
      With oSheet.Range("A1", "D1")
         .Font.Bold = True
         .VerticalAlignment = xlVAlignCenter
      End With
      
   ' Формировать массив данных для таблицы (Create an array to set multiple values at once).
      Dim saNames(5, 2) As String
      saNames(0, 0) = "John"
      saNames(0, 1) = "Smith"
      saNames(1, 0) = "Tom"
      saNames(1, 1) = "Brown"
      saNames(2, 0) = "Sue"
      saNames(2, 1) = "Thomas"
      saNames(3, 0) = "Jane"
      saNames(3, 1) = "Jones"
      saNames(4, 0) = "Adam"
      saNames(4, 1) = "Johnson"
      
    ' Заполнить диапазон A2:B6 данными массива (фамилии и имена) (Fill A2:B6 with an array of values (First and Last Names)).
      oSheet.Range("A2", "B6").Value = saNames
      
    ' Заполнить диапазон C2:C6 данными таблицы, преобразованными с помощью формулы (фамилия-имя) (Fill C2:C6 with a relative formula (=A2 & " " & B2)).
      Set oRng = oSheet.Range("C2", "C6")
      oRng.Formula = "=A2 & "" "" & B2"
      
    ' Заполнить диапазон D2:D6 данными таблицы, преобразованными с использованием стандартной функции (Fill D2:D6 with a formula(=RAND()*100000) and apply format).
      Set oRng = oSheet.Range("D2", "D6")
      oRng.Formula = "=RAND()*100000"
      oRng.NumberFormat = "$0.00"
      
    ' Применение команды Автоширина к колонкам A:D (AutoFit columns A:D).
      Set oRng = oSheet.Range("A1", "D1")
      oRng.EntireColumn.AutoFit
      
    ' Вызов подпрограммы DisplayQuarterlySales с параметром текущего листа oSheet (Manipulate a variable number of columns for Quarterly Sales Data).
      Call DisplayQuarterlySales(oSheet)
      
    ' Уточнить, видимость программы Excel и наличие пользовательских элементов управления (UserControl) (Make sure Excel is visible and give the user control of Microsoft Excel's lifetime).
      oXL.Visible = True
      oXL.UserControl = True
      
    ' Удалить информацию о ссылках в программе (Make sure you release object references).
      Set oRng = Nothing
      Set oSheet = Nothing
      Set oWB = Nothing
      Set oXL = Nothing
      
    ' Выйти из программы.
   Exit Sub
Err_Handler:
      MsgBox Err.Description, vbCritical, "Error: " & Err.Number
   End Sub

Подпрограмма, которая вызывается в данном примере:

   Private Sub DisplayQuarterlySales(oWS As Excel.Worksheet)
      Dim oResizeRange As Excel.Range
      Dim oChart As Excel.Chart
      Dim iNumQtrs As Integer
      Dim sMsg As String
      Dim iRet As Integer
      
    ' Определить, данные по какому количеству кварталов будут выведены на лист (Determine how many quarters to display data for).
      For iNumQtrs = 4 To 2 Step -1
         sMsg = "Enter sales data for" & Str(iNumQtrs) & " quarter(s)?"
         iRet = MsgBox(sMsg, vbYesNo Or vbQuestion _
            Or vbMsgBoxSetForeground, "Quarterly Sales")
    ' Вывод на экран диалогового окна с сообщением sMsg (вопрос о количестве кварталов).
         If iRet = vbYes Then Exit For
    ' Если ответили Да, выходим из цикла.
      Next iNumQtrs

    ' Вывести на экран сообщения sMsg о количестве кварталов.
      sMsg = "Displaying data for" & Str(iNumQtrs) & " quarter(s)."
      MsgBox sMsg, vbMsgBoxSetForeground, "Quarterly Sales"

 

    ' Начиная с ячейки E1, заполнить шапку таблицы (названия колонок) (Starting at E1, fill headers for the number of columns selected).
      Set oResizeRange = oWS.Range("E1", "E1").Resize(ColumnSize:=iNumQtrs)
      oResizeRange.Formula = "=""Q"" & COLUMN()-4 & CHAR(10) & ""Sales"""

    ' Изменить ориентацию – наклон текста в шапке – и добавить в формате ячеек перенос по словам (WrapText; wrap – окутывать) (Change the Orientation and WrapText properties for the headers).
      oResizeRange.Orientation = 38
      oResizeRange.WrapText = True
      
    ' Окрасить шапку таблицы (Fill the interior color of the headers).
      oResizeRange.Interior.ColorIndex = 36
      
    ' Заполнить таблицу данными и применить к ячейкам заданный формат (Fill the columns with a formula and apply a number format).
      Set oResizeRange = oWS.Range("E2", "E6").Resize(ColumnSize:=iNumQtrs)
      oResizeRange.Formula = "=RAND()*100"
      oResizeRange.NumberFormat = "$0.00"
      
    ' Отформатировать границы (Apply borders to the Sales data and headers).
      Set oResizeRange = oWS.Range("E1", "E6").Resize(ColumnSize:=iNumQtrs)
      oResizeRange.Borders.Weight = xlThin

    ' Применить формулу суммирования и отформатировать нижнюю границу (Add a Totals formula for the sales data and apply a border).
      Set oResizeRange = oWS.Range("E8", "E8").Resize(ColumnSize:=iNumQtrs)
      oResizeRange.Formula = "=SUM(E2:E6)"
      With oResizeRange.Borders(xlEdgeBottom)
         .LineStyle = xlDouble
         .Weight = xlThick
      End With
      
    ' Добавить диаграмму, построенную на основе указанных данных (Add a Chart for the selected data)
      Set oResizeRange = oWS.Range("E2:E6").Resize(ColumnSize:=iNumQtrs)
      Set oChart = oWS.Parent.Charts.Add
      With oChart
         .ChartWizard oResizeRange, xl3DColumn, , xlColumns
         .SeriesCollection(1).XValues = oWS.Range("A2", "A6")
            For iRet = 1 To iNumQtrs
               .SeriesCollection(iRet).Name = "=""Q" & Str(iRet) & """"
            Next iRet
        ' Диаграмма размещается на листе под таблицей
         .Location xlLocationAsObject, oWS.Name
      End With
      
    ' Переместить диаграмму (Move the chart so as not to cover your data).
      With oWS.Shapes("Chart 1")
         .Top = oWS.Rows(10).Top
         .Left = oWS.Columns(2).Left
      End With
      
    ' Удалить информацию о ссылках в подпрограмме (Free any references).
      Set oChart = Nothing
      Set oResizeRange = Nothing
   
   End Sub
Удобной и приятной работы в Word!
Перевести спасибо на Яндекс кошелёк - 41001162202962; на WebMoney - R581830807057.