Александр Шабля
дата публикации 24-04-2006 06:55

---

Версия для печати

Запись макроса (меню 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

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

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.Characters.Text = "Наша надпись"

Вот оно что! Значит 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

Дальше определим тип объекта после строки 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

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

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

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

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

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, мы в самом деле не найдем такого свойства и метода... Попробуем подправить код:

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:

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? Сравните:

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

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

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. Усложним его - полностью создадим таблицу с данными, создадим график и изменим цвет первого столбца:

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

Полезные ссылки:

1. MSDN:Automating Excel Using the Excel Object Model
2. How to automate Microsoft Excel from Microsoft Visual C# .NET
3. MSDN:Understanding the Excel Object Model from a .NET Developer's Perspective
4. MSDN:Microsoft Excel Object Model
5. Excel Tips: Macros and VBA
6. Add a Chart to a Worksheet Programmatically (C#)
7. MSDN: Best Practices for Setting Range Properties

Специально для Королевства Delphi

• Книга Excel с приведенными в статье макросами (17.8 K) обновление от 4/24/2006 7:00:00 AM
• Demo-проект на Delphi (6 K) обновление от 4/24/2006 7:00:00 AM
• Demo-проект на C# (392 K) обновление от 4/24/2006 7:00:00 AM