Перенос VBA-макросов в Delphi (исходники)

Источник: Королевство Delphi

Александр Шабля

Запись макроса (меню Excel "Сервис\Макрос\Начать запись…") незаменимая вещь при написании отчетов или создания диаграмм в Excel'е, особенно для тех, кто только начинает с ним работать. Но, записанный в Excel макрос, иногда выглядит довольно громоздко и читается с трудом. В данной статье я хочу рассмотреть методы перевода записанных макросов в более удобный вид для использования их в Delphi. Также будет рассмотрены некоторые нестыковки в объектной модели Excel'я в записанных макросах и методы их исправления.

Для начала рассмотрим записанные в Excel'е макросы и попробуем сократить их VBA-код для переноса в Delphi. Откроем в Excel'e новую книгу и выполним, к примеру, простые действия - запустим запись макроса, выделим область "A1:D5" и в тулбаре "Границы" выберем "Все границы". Остановим запись макроса и посмотрим, что у нас получилось. Должен появиться примерно такой код (чтоб открыть VBA редактор в Excel'е нажмите Alt+F11):

Sub Макрос1() ' Range("A1:D5").Select Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideHorizontal) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With  End Sub

Да, многовато… Давайте посмотрим, что содержит полученный VBA-код:

Выделили область и убрали диагональные линии (а они у нас были?).
Нарисовали последовательно левую, верхнюю, правую, нижнюю границы.
Нарисовали внутренние горизонтальные и вертикальные границы.

Теперь попробуем сократить этот макрос, например, так (скопируйте код, приведенный ниже в VBA редактор):

Sub Макрос1_1() ' With Range("A1:D5").Borders .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With  End Sub

Очистим область "A1:D5" от границ и запустим наш макрос (перейдите в Excel из редактора, нажмите Alt+F8, выберите Макрос1_1 и нажмите "Выполнить"). Код намного короче, а результат тот же! Что мы сделали? Во-первых, убрали Select, просто указав какую область мы будем "обордюривать", во-вторых, вообще не указали какие границы будем заполнять, просто написав Borders без параметров (т.е. все). Почему понадобилось убирать Select? Потому что, во-первых, можно обойтись без него, а во-вторых, Select вызывает доп. перерисовку экрана, а это, как известно, самые долгие операции.

Теперь перейдем к другой "особенности" записи макроса, а именно к непонятному свойству объекта [Excel.]Application Selection. Что это такое? В данном макросе, как можно догадаться это область ячеек (Range). Давайте запишем еще один макрос: добавим окно инструментов "Рисование", включим запись макроса, выберем тулбар "Надпись", поместим ее на наш лист и наберем текст "Наша надпись". Выделим ячейку A1 и остановим запись макроса. Должен получиться примерно такой код:

Sub Макрос2() ' ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 19.5, 88.5, _ 191.25, 86.25).Select Selection.Characters.Text = "Наша надпись" With Selection.Characters(Start:=1, Length:=7).Font .Name = "Arial" .FontStyle = "обычный" .Size = 10 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With Range("A1").Select  End Sub

Опять попробуем сократить код:

Sub Макрос2_2()  Dim MyShape As Shape  Set MyShape = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, _ 19.5, 88.5, 191.25, 86.25)  MyShape.Characters.Text = "Наша надпись"  End Sub

Перейдем в Excel, удалим нашу надпись и выполним макрос Макрос2_2. Получим ошибку "Объект не поддерживает данное свойство или метод" на строке с кодом

MyShape.Characters.Text = "Наша надпись".

Почему Selection его поддерживает, а Shape нет? Посмотрев на объект Shape мы не найдем свойства Characters. Что же скрывается за загадочным Selection? Для того чтобы это понять давайте в Макрос2, добавим строку MsgBox TypeName(Selection) после строки

Selection.Characters.Text = "Наша надпись"

и выполним макрос. Получим сообщение "TextBox" . Вот оно что! Значит Selection - это TextBox. Попробуем создать такой объект и… Нет такого объекта! Есть только TextFrame. Замена Shape на TextFrame тоже не увенчается успехом… Что же делать?

Посмотрим на свойства объекта Shape и увидим там свойство TextFrame, у которого уже есть свойство Characters… Посмотрев справку по VBA можно убедиться, что Characters - это метод и принадлежит объекту TextFrame. Пробуем:

Sub Макрос2_2() ' Dim MyShape As Shape  Set MyShape = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, _ 19.5, 88.5, 191.25, 86.25)  MyShape.TextFrame.Characters.Text = "Наша надпись" End Sub

Запустим макрос - работает! Оставим мифический TextBox на совести Microsoft…

Примечание:
объект TextBox таки существует, но только как Control для Form.

Еще небольшой пример на VBA про Selection и займемся непосредственно переносом кода из VBA в Delphi. Откройте файл Книга1.xls, который приложен к статье и перейдите на Лист2. Там таблица и график. Включим запись макроса, выделим первый столбик, вызовем "Формат рядов данных" и изменим цвет на темно синий. Остановим запись. Должен получиться примерно такой код:

Sub Макрос3() ' ActiveSheet.ChartObjects("Диагр. 1").Activate ActiveChart.SeriesCollection(1).Select  With Selection.Border .Weight = xlThin .LineStyle = xlAutomatic End With Selection.InvertIfNegative = False With Selection.Interior .ColorIndex = 23 .Pattern = xlSolid End With End Sub

Проверим, как он работает - перейдем в Excel, вызовем макросы и запустим Макрос3… Ошибка на первой же строке! Записанный макрос не работает. Почему? Попробуем сделать так, чтоб он заработал. Напишем небольшой макрос (руками) и будем вставлять в него код и тестировать. Начнем с определения имен имеющихся на листе диаграмм:

Sub Test1() Dim i As Integer  For i = 1 To ActiveSheet.ChartObjects.Count MsgBox ActiveSheet.ChartObjects(i).Name Next i  End Sub

Запустив макрос, получим имя диаграммы "Chart 1" - почему не "Диагр. 1", как в записанном макросе - это очередная загадка. Исправим макрос и проверим:

Sub Макрос3() ' ActiveSheet.ChartObjects("Chart 1").Activate ActiveChart.SeriesCollection(1).Select  With Selection.Border .Weight = xlThin .LineStyle = xlAutomatic End With Selection.InvertIfNegative = False With Selection.Interior .ColorIndex = 23 .Pattern = xlSolid End With End Sub

Работает :o). Дальше определим тип объекта после строки ActiveChart.SeriesCollection(1).Select известной строкой MsgBox TypeName(Selection). Получим Series. Сократим макрос и избавимся от Selection.

Sub Макрос3_3() ' Dim ch As Chart, s As Series  Set ch = ActiveSheet.ChartObjects("Chart 1").Chart Set s = ch.SeriesCollection(1)  With s.Interior .ColorIndex = 23 .Pattern = xlSolid End With End Sub

Если посмотреть на код Макрос3 и Макрос3_3, то видно, что код в Макрос3 использует Selection как промежуточный буфер для передачи управления между объектами, т.е. Activate, Select и для "безликого" вызова свойств и методов. Чтобы получить объект типа Chart нам понадобилось добавить обращение к свойству ChartObject.Chart

Set ch = ActiveSheet.ChartObjects("Chart 1").Chart

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

Перенесем наш код в Delphi и параллельно в C# (если не возражаете). Сразу оговорюсь, что в статье не рассматриваются методы подключения к Excel'ю (по данному вопросу можно почитать здесь ), также используется раннее связывание (что это такое читайте здесь).

Я считаю позднее связывание не "паскалевким" подходом, так как везде используется один тип Variant (как в языке "Основняк"), что, по моему, сродни шаманизму - что-то происходит, что-то куда то записывается, но никто не понимает, почему это работает.

Начнем с Макрос1. Да, именно с него, а не сокращенного варианта. Попытаемся написать код для первых трех строк:

Delphi

ASheet.Range['A1:D5', EmptyParam].Select; XL.Selection[lcid].Borders[xlDiagonalDown].LineStyle := xlNone; XL.Selection[lcid].Borders[xlDiagonalUp].LineStyle := xlNone;

Попробовав скомпилировать данный участок, сразу же получим ошибку компилятора " E2003 Undeclared identifier: 'Borders' ". Посмотрим, какой тип имеет Selection (в данном примере смотрим файл Excel2000.pas):

property ExcelApplication.Selection[lcid: Integer]: IDispatch;

Посмотрев на интерфейс IDispatch, мы в самом деле не найдем такого свойства и метода... Попробуем подправить код:

Delphi

ASheet.Range['A1:D5', EmptyParam].Select; (XL.Selection[lcid] as ExcelRange).Borders[xlDiagonalDown].LineStyle := xlNone; (XL.Selection[lcid] as ExcelRange).Borders[xlDiagonalUp].LineStyle := xlNone; with (XL.Selection[lcid] as ExcelRange).Borders[xlEdgeLeft] do begin LineStyle := xlContinuous; Weight := xlThin; ColorIndex := xlAutomatic; end; with (XL.Selection[lcid] as ExcelRange).Borders[xlEdgeTop] do begin LineStyle := xlContinuous; Weight := xlThin; ColorIndex := xlAutomatic; end; with (XL.Selection[lcid] as ExcelRange).Borders[xlEdgeBottom] do begin LineStyle := xlContinuous; Weight := xlThin; ColorIndex := xlAutomatic; end; with (XL.Selection[lcid] as ExcelRange).Borders[xlEdgeRight] do begin LineStyle := xlContinuous; Weight := xlThin; ColorIndex := xlAutomatic; end;

ASheet.get_Range("A1:D5", Type.Missing).Select(); ((Excel.Range) XL.Selection).Borders.get_Item( Excel.XlBordersIndex.xlDiagonalDown).LineStyle = Excel.XlLineStyle.xlLineStyleNone; ((Excel.Range) XL.Selection).Borders.get_Item( Excel.XlBordersIndex.xlDiagonalUp).LineStyle = Excel.XlLineStyle.xlLineStyleNone; // левая граница ((Excel.Range) XL.Selection).Borders.get_Item( Excel.XlBordersIndex.xlEdgeLeft).LineStyle = Excel.XlLineStyle.xlContinuous; ((Excel.Range) XL.Selection).Borders.get_Item( Excel.XlBordersIndex.xlEdgeLeft).Weight = Excel.XlBorderWeight.xlThin; ((Excel.Range) XL.Selection).Borders.get_Item( Excel.XlBordersIndex.xlEdgeLeft).ColorIndex = Excel.XlColorIndex.xlColorIndexAutomatic; // верхняя граница ((Excel.Range) XL.Selection).Borders.get_Item( Excel.XlBordersIndex.xlEdgeTop).LineStyle = Excel.XlLineStyle.xlContinuous; ((Excel.Range) XL.Selection).Borders.get_Item( Excel.XlBordersIndex.xlEdgeTop).Weight = Excel.XlBorderWeight.xlThin; ((Excel.Range) XL.Selection).Borders.get_Item( Excel.XlBordersIndex.xlEdgeTop).ColorIndex = Excel.XlColorIndex.xlColorIndexAutomatic; // нижняя граница ((Excel.Range) XL.Selection).Borders.get_Item( Excel.XlBordersIndex.xlEdgeBottom).LineStyle = Excel.XlLineStyle.xlContinuous; ((Excel.Range) XL.Selection).Borders.get_Item( Excel.XlBordersIndex.xlEdgeBottom).Weight = Excel.XlBorderWeight.xlThin; ((Excel.Range) XL.Selection).Borders.get_Item( Excel.XlBordersIndex.xlEdgeBottom).ColorIndex = Excel.XlColorIndex.xlColorIndexAutomatic; // правая граница ((Excel.Range) XL.Selection).Borders.get_Item( Excel.XlBordersIndex.xlEdgeRight).LineStyle = Excel.XlLineStyle.xlContinuous; ((Excel.Range) XL.Selection).Borders.get_Item( Excel.XlBordersIndex.xlEdgeRight).Weight = Excel.XlBorderWeight.xlThin; ((Excel.Range) XL.Selection).Borders.get_Item( Excel.XlBordersIndex.xlEdgeRight).ColorIndex = Excel.XlColorIndex.xlColorIndexAutomatic;

Работает… Что мы для этого сделали? Привели тип IDispatch к ExcelRange: XL.Selection[lcid] as ExcelRange). Но такой перевод записанного макроса в Delphi поистине героический труд, да и нужен ли нам Select для того чтоб нарисовать границы (а глядя на C# код, вообще можно сразу отказаться на нем программировать)? Ведь всякая перерисовка - лишняя трата времени и, следовательно, скорости. Поэтому займемся Макросом1_1:

Delphi

with ASheet.Range['A1:D5', EmptyParam].Borders do begin LineStyle := xlContinuous; Weight := xlThin; ColorIndex := xlAutomatic; end;

oRng = ASheet.get_Range("A1:D5", Type.Missing); // установим све границы oRng.Borders.LineStyle = Excel.XlLineStyle.xlContinuous; oRng.Borders.Weight = Excel.XlBorderWeight.xlThin; oRng.Borders.ColorIndex = Excel.XlColorIndex.xlColorIndexAutomatic;

Различия есть? Мы не делали Select и не использовали безликий Selection, обратившись непосредственно к области ExcelRange. Или все же лучше с Selection? Сравните:

Delphi

ASheet.Range['A1:D5', EmptyParam].Select; with (XL.Selection[lcid] as ExcelRange).Borders do begin LineStyle := xlContinuous; Weight := xlThin; ColorIndex := xlAutomatic; end;

Все то же самое, но что-то рябит в глазах при Select, не правда ли? И вроде как-то медленнее или мне показалось?

Перейдем к Макрос2, вернее к уже подготовленному Макрос2_2: Delphi

MyShape := (XL.ActiveWorkbook.ActiveSheet as _Worksheet).Shapes.AddTextbox( msoTextOrientationHorizontal, 19.5, 88.5, 191.25, 86.25); MyShape.TextFrame.Characters(EmptyParam, EmptyParam).Text := 'Наша надпись';

myShape = (Excel.Shape) ASheet.Shapes.AddTextbox( Office.MsoTextOrientation.msoTextOrientationHorizontal, (float) 19.5, (float) 88.5, (float) 191.25, (float) 86.25); myShape.TextFrame.Characters(Type.Missing, Type.Missing).Text = "Наша надпись";

В коде на Delphi практически никаких отличий, кроме указания двух обязательных параметров: начала изменяемых символов и их длины. Мы написали EmptyParam, тем самым указав, что обрабатывается весь текст.

И, наконец, Макрос3_3. Усложним его - полностью создадим таблицу с данными, создадим график и изменим цвет первого столбца:

Delphi

oSheet.Cells.Item[1, 1] := 'First Name'; oSheet.Cells.Item[1, 2] := 'Last Name'; oSheet.Cells.Item[1, 3] := 'Full Name'; oSheet.Cells.Item[1, 4] := 'Salary';  //Format A1:D1 as bold, vertical alignment := center. oSheet.Range['A1', 'D1'].Font.Bold := True; oSheet.Range['A1', 'D1'].VerticalAlignment := xlVAlignCenter;  // Create an array to multiple values at once. saNames := VarArrayCreate([0, 4, 0, 1], varVariant);  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';  oSheet.Range['A2', 'B6'].Formula := saNames;  oRng := oSheet.Range['C2', 'C6']; oRng.Formula := '=A2 & " " & B2';  oRng := oSheet.Range['D2', 'D6']; oRng.Formula := '=RAND()*100000';  oSheet.Range['A1', 'D1'].EntireColumn.AutoFit;  // создадим график на листе в обласи E8:L29 Ch := (oSheet.ChartObjects as ChartObjects).Add( oSheet.Range['B8', EmptyParam].Left, oSheet.Range['B8', EmptyParam].Top, oSheet.Range['I8', EmptyParam].Left - oSheet.Range['B8', EmptyParam].Left, oSheet.Range['B30', EmptyParam].Top - oSheet.Range['B8', EmptyParam].Top).Chart as _Chart;  oRng := oSheet.Range['C1', 'D6']; with Ch do begin SetSourceData(oRng, xlRows); ChartType := xl3DColumnClustered; HasTitle[lcid] := True; ChartTitle[lcid].Characters[EmptyParam, EmptyParam].Text := 'Диаграмма 1'; (Axes(xlCategory, xlPrimary, lcid) as Axis).HasTitle := False; (Axes(xlValue, xlPrimary, lcid) as Axis).HasTitle := True; (Axes(xlValue, xlPrimary, lcid) as Axis).AxisTitle. Characters[EmptyParam, EmptyParam].Text := 'Деньги'; (Axes(xlValue, xlPrimary, lcid) as Axis).AxisTitle.Orientation := xlUpward; end;  // здесь код замены цвета у первого столбика // взятый из Макрос3_3 with (Ch.SeriesCollection(1, lcid) as Series) do begin Interior.ColorIndex := 23; Interior.Pattern := xlSolid; end;

oSheet.Cells[1, 1] = "First Name"; oSheet.Cells[1, 2] = "Last Name"; oSheet.Cells[1, 3] = "Full Name"; oSheet.Cells[1, 4] = "Salary"; //Format A1:D1 as bold, vertical alignment := center. oSheet.get_Range("A1", "D1").Font.Bold = true; oSheet.get_Range("A1", "D1").VerticalAlignment = Excel.XlVAlign.xlVAlignCenter; oSheet.get_Range("A1", "D1").HorizontalAlignment = Excel.XlHAlign.xlHAlignCenter; // Create an array to multiple values at once. string[,] saNames = new string[5, 2];  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";  oSheet.get_Range("A2", "B6").Formula = saNames;  //Fill C2:C6 with a relative formula (=A2 & " " & B2). oRng = oSheet.get_Range("C2", "C6"); oRng.Formula = "=A2 & \" \" & B2";  //Fill D2:D6 with a formula(=RAND()*100000) and apply format. oRng = oSheet.get_Range("D2", "D6"); // oRng.Formula = "=RAND()*100000"; oRng.Formula = "=СЛЧИС()*100000"; // oRng.NumberFormat = "0.00";  //AutoFit columns A:D. oRng = oSheet.get_Range("A1", "D1"); oRng.EntireColumn.AutoFit();  // создадим график на листе в обласи E8:L29 Ch =  ((Excel.ChartObjects) oSheet.ChartObjects(Type.Missing)).Add( (double) oSheet.get_Range("B8", Type.Missing).Left, (double) oSheet.get_Range("B8", Type.Missing).Top, (double) oSheet.get_Range("I8", Type.Missing).Left - (double) oSheet.get_Range("B8", Type.Missing).Left, (double) oSheet.get_Range("B30", Type.Missing).Top - (double) oSheet.get_Range("B8", Type.Missing).Top ).Chart;  oRng = oSheet.get_Range("C1", "D6"); Ch.SetSourceData(oRng, Excel.XlRowCol.xlRows); Ch.ChartType = Excel.XlChartType.xl3DColumnClustered; Ch.HasTitle = true; Ch.ChartTitle.get_Characters(Type.Missing, Type.Missing).Text = "Диаграмма 1"; ((Excel.Axis) Ch.Axes(Excel.XlAxisType.xlCategory, Excel.XlAxisGroup.xlPrimary)).HasTitle = false; ((Excel.Axis) Ch.Axes(Excel.XlAxisType.xlValue, Excel.XlAxisGroup.xlPrimary)).HasTitle = true; ((Excel.Axis) Ch.Axes(Excel.XlAxisType.xlValue, Excel.XlAxisGroup.xlPrimary)).AxisTitle. get_Characters(Type.Missing, Type.Missing).Text = "Деньги"; ((Excel.Axis) Ch.Axes(Excel.XlAxisType.xlValue, Excel.XlAxisGroup.xlPrimary)).AxisTitle.Orientation = Excel.XlOrientation.xlUpward;  // здесь код замены цвета у первого столбика // взятый из Макрос3_3 ((Excel.Series) Ch.SeriesCollection(1)).Interior.ColorIndex = 23; ((Excel.Series) Ch.SeriesCollection(1)).Interior.Pattern = Excel.XlPattern.xlPatternSolid;

Из перенесенных строк из Макрос3_3 видно, что коллекция Ch.SeriesCollection(1, lcid) тоже возвращает интерфейс IDispatch, поэтому мы привели ее к типу Series. Почему в библиотеке типов сразу не использован тип Series остается только гадать. Еще в только что описанном примере приведен код задания титулов для осей (axes) и здесь метаморфоза превращения Axes в Axis, т.е. Axes - это коллекция Axis, хотя в VBA это ни как не отображается.

Резюме:

Мы рассмотрели несколько примеров перевода VBA кода, созданного записью макроса в Excel в Delphi. Увидели, как можно сократить ненужный код, избавившись от Select. Как уйти от безликого Selection (тип IDispatch) во избежание ошибок и возможных недоразумений. Также обнаружили несоответствие записанного кода (к примеру, имени объекта "Наша надпись") и типов реальным типам объектов. Т.е. записанный код VBA не всегда оказывается работоспособным. Для правильного перевода VBA в Delphi требуется представление об объектной модели Excel'я, обращение к справке Excel VBA, а также большое желание достигнуть результата.

Все примеры тестировались на BDS 2006 и Microsoft Office 2003
К статье прилагается Книга1.xls с приведенными в статье макросами и Demo-проект на Delphi и C#. Для работы проекта на C# требуется Framework 1.1

Новости рынка средств разработки и корпоративного программного обеспечения.

Delphi: Интерфейс в XPерементальном стиле.

Акция компании Embarcadero: Обновите Delphi, C++Builder, RAD Studio - с ЛЮБОЙ версии!.

Flash в Delphi.

Быстрая обработка данных Excel в Delphi.

Главная » Delphi