|
00.2 Уч-мет пос МПиС d4 (1). Лабораторная работа Формирование статистической таблицы с возможностью сортировки, фильтрации и группировки данных 4
Лабораторная работа № 7.
Работа с Microsoft Excel из Delphi
Создание экземпляра Excel.Application
Модуль импортированной Excel TLB содержит описания всех интерфейсов. Подключаем Excel для последующего использования:
procedure TForm1.CreateExcel(NewInstance: boolean);
begin
ifnotAssigned(IXLSApp) thenbegin
FIXLSApp := TExcelApplication.Create(Self);
if NewInstance then FIXLSApp.ConnectKind := ckNewInstance;
FIXLSApp.Connect;
end;
end;
Delphi предоставляет более удобный сервис при импорте библиотек типов. Большой шаг вперед - появление класса ToleServer с поддержкой событий. Работа с существующими и создание новых OLE-серверов намного удобней. Отличная библиотека была создана Бином Ли (Binh Ly) в COM Nodes - Threading COM Library.
Обращаем внимание только на параметр NewInstance. Позволяет создать новый процесс. Если не хотите потерять уже открытые, но еще не сохраненные книги, создавайте новый процесс.
procedure TForm1.ShowExcel;
begin
if Assigned(FIXLSApp) thenbegin // а если он не создан?
FIXLSApp.Visible[0] := true;
if FIXLSApp.WindowState[0] = TOLEEnum(xlMinimized) then
FIXLSApp.WindowState[0] := TOLEEnum(xlNormal);
FIXLSApp.ScreenUpdating[0] := true;
end;
end;
Свойства Visible, WindowState и ScreenUpdating вызываются с индексом массива - 0. В модуле Excel TLB во многих свойствах и методах можете встретить параметр или индекс lcid.
Затем прячем Excel.
procedure TForm1.HideExcel;
begin
if Assigned(FIXLSApp) thenbegin
FIXLSApp.Visible[0] := false;
end;
end;
При закрытии приложения Excel будет закрыт. Освобождать все ресурсы надо самостоятельно.
procedure TForm1.ReleaseExcel;
begin
if Assigned(FIXLSApp) thenbegin
if (FIXLSApp.Workbooks.Count > 0) and (not FIXLSApp.Visible[0]) thenbegin
FIXLSApp.WindowState[0] := TOLEEnum(xlMinimized);
FIXLSApp.Visible[0] := true;
Application.BringToFront;
end;
end;
FIXLSApp := nil;
end;
Попробуйте: CreateExcel, ShowExcel, HideExcel, ReleaseExcel. Если оставить только присваивание в nil, то существовавший процесс не будет выгружен, но будет спрятан от пользователя с его открытой книгой.
procedure TForm1.ReleaseExcel;
begin
if Assigned(IXLSApp) thenbegin
if (IXLSApp.Workbooks.Count > 0) and (not IXLSApp.Visible[0]) thenbegin
IXLSApp.WindowState[0] := TOLEEnum(xlMinimized);
IXLSApp.Visible[0] := true;
ifnot(csDestroying in ComponentState) then Self.SetFocus;
Application.BringToFront;
end;
end;
FreeAndNil(FIXLSApp);
end;
Работаете уже не с интерфейсом напрямую, а с экземпляром класса TexcelApplcation. Если посмотреть его предков, то можно увидеть, что это настоящий класс, освободить который необходимо. Поэтому вместо присваивания в nil там написано FreeAndNil.
Шаблоны позволяют избежать ручного (в исходном тексте) форматирования. В общем случае, алгоритм выглядит просто: по шаблону создается книга, каким-то образом помеченные области заполняются данными и… (а дальше все уже готово).
function TForm1.AddWorkbook(const WorkbookName: string): Excel8TLB._Workbook;
begin
Result := nil;
if Assigned(FIXLSApp) and (trim(WorkbookName) <> '') then begin
Result := FIXLSApp.Workbooks.Add(WorkbookName, 0);
end;
end;
Существует масса способов передать данные в Excel, начиная с DDE и заканчивая обычным присваиванием (типа Cell.Value := NewValue). Максимальную скорость передачи данных можно получить, только используя DDE. Итак, после нажатия кнопки CreateExcel имеем открытый шаблон с листом "Лист1" и областью с именем "TestRange". Опишем константный массив с тестовыми данными - TestDataArray. Именно эти данные я и передаю в ячейки области:
procedure TForm1.btnDataClick(Sender: TObject);
type
var LaunchDir: string;
IWorkbook: Excel97.ExcelWorkbook;
ISheet: Excel97.ExcelWorksheet;
IRange: Excel97.Range;
NewValueArray, V: OLEVariant;
i: integer;
begin
if Assigned(IXLSApp) thenbegin
LaunchDir := ExtractFilePath( ParamStr(0) );
IWorkbook := AddWorkbook( LaunchDir + 'Test.xls' );
try
ISheet := IWorkbook.Worksheets.Item['Лист1'] as Excel97.ExcelWorksheet;
IRange := ISheet.Range['TestRange', EmptyParam];
NewValueArray := VarArrayCreate([0, 20, 1, 4], varVariant);
for i := 0 to 20 dobegin
NewValueArray[i, 1] := TestDataArray[i].V1;
NewValueArray[i, 2] := TestDataArray[i].V2;
NewValueArray[i, 3] := TestDataArray[i].V3;
NewValueArray[i, 4] := date + i;
end;
IRange.Value := NewValueArray;
finally
IRange := nil;
ISheet := nil;
IWorkbook := nil;
end;
end;
end;
Создание или открытие книги
В главной форме проекта-примера объявляем свойство IWorkbook. Будет содержать интерфейс книги, которую будем создавать и использовать. В обработчике FormDestroy его освобождаем.
property IWorkbook: Excel8TLB._Workbook read FIWorkbook;
Книгу можно создать разными способами. Если необходимо создать абсолютно чистую книгу, достаточно выполнить следующий код:
if Assigned(IXLSApp) and (not Assigned(IWorkbook)) then
FIWorkbook := IXLSApp.Workbooks.Add(EmptyParam, 0);
Вопрос в том, зачем может понадобиться новая книга, с количеством пустых листов, выставленным по умолчанию.
Коллекция Workbooks содержит все открытые книги и предоставляет возможность кое-как управлять контекстом.
Пример поиска книги с заданным именем:
Public Function SheetExists(strSearchFor As String) AsBoolean
SheetExists = False
ForEach sht In ThisWorkbook.Worksheets
If sht.Name = strSearchFor Then
SheetExists = True
EndIf
Next sht
EndFunction
Метод Add этой коллекции (метод интерфейса) позволяет добавить книгу к коллекции, пустую либо по шаблону. Первый параметр метода, Template (из справки по Excel VBA), может принимать имя файла с путем. Поэтому, выполнив код:
if Assigned(IXLSApp) and (not Assigned(IWorkbook) ) then
FIWorkbook := IXLSApp.Workbooks.Add(ExtractFilePath(ParamStr(0)) + 'Test.xls', 0);
получите книгу, идентичную файлу "Test.xls" с именем Test1.xls. Именно этим способом создаются отчеты.
Если же необходимо просто открыть уже существующий файл, то используйте метод Open этой же коллекции:
if Assigned(IXLSApp) and (not Assigned(IWorkbook)) then
FIWorkbook := IXLSApp.Workbooks.Open(ExtractFilePath(ParamStr(0)) + "Test.xls', EmptyParam,
EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam,
EmptyParam, EmptyParam, EmptyParam, false, 0);
Чтобы не мучаться с написанием такого количества EmptyParam, можно написать и так:
if Assigned(IXLSApp) and (not Assigned(IWorkbook) ) then
IDispatch(FIWorkbook) := OLEVariant(IXLSApp.Workbooks).Open(
FileName := ExtractFilePath(ParamStr(0)) + 'Test.xls');
Что же стоит за таким количеством параметров по умолчанию в методе Open? Из этого «громадья» используем лишь несколько вещей. Объявление этого метода в импортированной библиотеке типов:
function Open(const Filename: WideString; UpdateLinks: OleVariant; ReadOnly: OleVariant;
Format: OleVariant; Password: OleVariant; WriteResPassword: OleVariant;
IgnoreReadOnlyRecommended: OleVariant; Origin: OleVariant;
Delimiter: OleVariant; Editable: OleVariant; Notify: OleVariant;
Converter: OleVariant; AddToMru: OleVariant; lcid: Integer): Workbook; safecall;
В FileName необходимо передать имя открываемого файла, желательно указав путь его нахождения. Иначе, этот файл Excel будет искать в каталоге по умолчанию. Чтобы файл был запомнен в списке последних открытых файлов, в AddToMru можно передать true. Иногда файл рекомендован только для чтения. Тогда при открытии выдается соответствующее сообщение. Чтобы игнорировать его, можно передать в IgnoreReadOnlyRecommended true.
На главной форме проекта-примера создаем кнопку, с помощью которой можно открыть (или создать) файл и RadioGroup, где можно указать каким из приведенных выше способов файл открывается:
procedure TForm1.btnCreateBookClick(Sender: TObject);
var FullFileName: string;
begin
FullFileName := ExtractFilePath(ParamStr(0)) + 'Test.xls';
if Assigned(IXLSApp) and (not Assigned(IWorkbook) ) then
try
case rgWhatCreate.ItemIndex of
// По шаблону
0: FIWorkbook := IXLSApp.Workbooks.Add(FullFileName, 0);
// Просто откроем
1: FIWorkbook := IXLSApp.Workbooks.Open(FullFileName,
EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam,
EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, false, 0);
// Пустая книга
2: FIWorkbook := IXLSApp.Workbooks.Add(EmptyParam, 0);
end;
except
raise Exception.Create('Не могу создать книгу!');
end;
end;
Работа с листами книги
ActiveSheet и ActiveWorkbook, а также возможность работы с Cells и Range без указания, к какому листу или книге они принадлежат. Прежде, чем работать с отдельными ячейками, всегда получаем интерфейс на конкретный и вполне осязаемый лист книги:
var ISheet: Excel8TLB._Worksheet;
…
ISheet := IWorkbook.Worksheets.Item['Лист1'] as Excel8TLB._Worksheet;
Коллекция Worksheet подобна всем остальным коллекциям из Excel TLB. Можете удалять листы, вставлять новые, изменять их порядок.
Всегда и везде рекомендую работать с ячейками и областями в контексте их листа, получив предварительно интерфейс на этот лист вышеописанным способом. От использования свойств ActiveSheet и ActiveWorkbook можно совсем отказаться, разве что за исключением каких-то особых случаев.
Чтение данных из ячейки
Используются разные способы обращения к ячейкам от привычного в Excel Cells(x,y) до коллекции Names. Вот некоторые примеры:
procedure TForm1.btnReadDataClick(Sender: TObject);
var Value: OLEVariant;
ISheet: Excel8TLB._Worksheet;
begin
if Assigned(IWorkbook) then
try
ISheet := IWorkbook.Worksheets.Item['Лист1'] as Excel8TLB._Worksheet;
try
case rgWhatRead.ItemIndex of
0: Value := ISheet.Cells.Item[2, 1].Value;
1: Value := ISheet.Range['A2', EmptyParam].Value;
2: Value := ISheet.Range['TestCell', EmptyParam].Value;
3: Value := IWorkbook.Names.Item('TestCell', EmptyParam,
EmptyParam).RefersToRange.Value;
end;
ShowMessage(Value);
finally
ISheet := nil;
end;
except
raise Exception.Create('Не могу прочитать данные!');
end;
end;
На главную форму проекта добавляем кнопку, по которой можно прочитать данные из ячейки «А2» открытой книги, и RadioGroup к ней, чтобы выбрать способ получения этих данных. Из приведенного кода видна одна из особенностей - освобождать все полученные интерфейсы явно (ISheet := nil). Самый повторяющийся вопрос, это вопрос о Cells. Почему-то многие уверены, что конструкция Cells[x,y].Value должна работать. В VBA это так. Но при раннем связывании это не соответствует истине. Свойство Cells объявлено у всех интерфейсов как:
property Cells: Range read Get_Cells;
Отсюда видно, что это область (Range). И нет там никаких индексов, чтобы пробовать писать [x,y]. Стандартное объявление этих свойств:
property _Default[RowIndex: OleVariant; ColumnIndex: OleVariant]: OleVariant dispid 0;
property Item[RowIndex: OleVariant; ColumnIndex: OleVariant]: OleVariant dispid 170;
можно исправить на такой вариант:
property _Default[RowIndex: OleVariant; ColumnIndex: OleVariant]: OleVariant dispid 0; default;
property Item[RowIndex: OleVariant; ColumnIndex: OleVariant]: OleVariant dispid 170;
и использовать Cells[x, y].Value.
В приведенном выше примере кода показано не только использование Cells. К ячейкам можно получить доступ и через свойство Range интерфейса Worksheet. Это свойство объявлено как:
property Range[Cell1: OleVariant; Cell2: OleVariant]: Range read Get_Range;
В Cell1 / Cell2 можно передать ячейки (только в формате А1, RC вызовет исключение), описывающие границы области - левый верхний угол и правый нижний.
В Excel можно присваивать имена любым ячейкам и даже наборам ячеек. Это можно сделать, либо используя «комбо-бокс», который находится левее строки формул, либо пункт меню «Вставка\Имя\Присвоить». Ячейке «А2» присвоим имя «TestCell» и, используя все то же свойство Range листа, получим значение ячейки по этому имени.
И последний вариант, это использование коллекции Names книги. Очень часто используются именованные ячейки и области, разбросанные по разным листам и даже книгам.
Чтение данных из нескольких ячеек
Имея ввиду все вышеописанное, можно просто организовать чтение данных из поименованной области:
procedure TForm1.btnReadArrayClick(Sender: TObject);
var Values: OLEVariant;
ISheet: Excel8TLB._Worksheet;
IRange: Excel8TLB.Range;
i, j: integer;
begin
if Assigned(IWorkbook) then
try
ISheet := IWorkbook.Worksheets.Item['Лист1'] as Excel8TLB._Worksheet;
try
IRange := ISheet.Range['TestRange2', EmptyParam];
Values := VarArrayCreate([1, IRange.Rows.Count, 1, IRange.Columns.Count], varVariant);
for i := 1 to IRange.Rows.Count do
for j := 1 to IRange.Columns.Count dobegin
Values[i, j] := IRange.Item[i, j];
ShowMessage( Values[i, j]);
end;
finally
IRange := nil;
ISheet := nil;
end;
except
raise Exception.Create('Не могу прочитать данные в массив!');
end;
end;
Создаем на форме кнопку, по которой из заранее подготовленной области с именем "TestRange2" все значения ячеек будут получены в вариантный массив Values. Вызов ShowMessage добавлен сюда только для контроля над процессом. Как видно, получить значения ячеек области достаточно просто. Создаете вариантный массив с количеством строк и колонок, равными размерам области, а затем, проходя по очереди все ячейки области, запоминаете их значения в массиве. Но в этом коде есть одна проблема. Чтение из ячеек можно организовать еще проще:
procedure TForm1.btnReadArrayClick(Sender: TObject);
var Values: OLEVariant;
ISheet: Excel8TLB._Worksheet;
IRange: Excel8TLB.Range;
begin
if Assigned(IWorkbook) then
try
ISheet := IWorkbook.Worksheets.Item['Лист1'] as Excel8TLB._Worksheet;
try
IRange := ISheet.Range['TestRange2', EmptyParam];
Values := IRange.Value;
for i := 1 to IRange.Rows.Count do
for j := 1 to IRange.Columns.Count dobegin
ShowMessage( Values[i, j]);
end;
finally
IRange := nil;
ISheet := nil;
end;
except
raise Exception.Create('Не могу прочитать данные в массив!');
end;
end;
Дело в том, что строки Values := IRange.Value вполне достаточно. Свойство Value интерфейса Range в состоянии вернуть вариантный массив. Этот код более прост и производителен, особенно на больших объемах данных.
А вот пример кода, который вернет в массиве значения всех ячеек из используемой области на листе, вернет весь лист:
var Values: OLEVariant;
ISheet: Excel8TLB._Worksheet;
IRange: Excel8TLB.Range;
i, j: integer;
begin
if Assigned(IWorkbook) then
try
ISheet := IWorkbook.Worksheets.Item['Лист1'] as Excel8TLB._Worksheet;
try
IRange := ISheet.UsedRange[0];
Values := IRange.Value;
finally
IRange := nil;
ISheet := nil;
end;
except
raise Exception.Create('Не могу прочитать данные в массив!');
end;
end;
Здесь используем свойство UsedRange листа. Это прямоугольная область, заключенная между «левой верхней непустой» и «правой нижней непустой» ячейками. Конечно, если в этой прямоугольной области будет много пустых ячеек, то массив получится с избыточными данными. Что бы убедиться в этом, попробуйте создать циклы с ShowMessage из предыдущего примера. В качестве параметра в UsedRange передаем 0.
Есть еще несколько способов чтения данных из книги. Один их таких способов, это использование DDE, самый быстрый и экономичный.
Поиск данных на листе
Предлагаю поискать все ячейки, содержащие строку (или подстроку) "Text", и изменить цвет фона этих ячеек. Для этого используем методы Find и FindNext. На форму добавлена кнопка, в обработчике которой появился следующий код:
procedure TForm1.btnFindClick(Sender: TObject);
var ISheet: Excel8TLB._Worksheet;
IFirst, IRange: Excel8TLB.Range;
FirstAddress, CurrentAddress: string;
UsedRange: OLEVariant;
begin
if Assigned(IWorkbook) then
try
ISheet := IWorkbook.Worksheets.Item['Лист1'] as Excel8TLB._Worksheet;
try
UsedRange := ISheet.UsedRange[0];
IDispatch(IFirst) := UsedRange.Find(What:='Text', LookIn := xlValues,
SearchDirection := xlNext);
if Assigned(IFirst) then begin
IRange := IFirst;
FirstAddress := IFirst.Address[EmptyParam, EmptyParam, xlA1, EmptyParam, EmptyParam];
repeat
IRange.Interior.ColorIndex := 37;
IDispatch(IRange) := UsedRange.FindNext(After := IRange);
CurrentAddress := IRange.Address[EmptyParam, EmptyParam, xlA1,
EmptyParam, EmptyParam];
until FirstAddress = CurrentAddress;
end;
finally
IRange := nil;
IFirst := nil;
ShowExcel;
end;
except
raise Exception.Create('Не могу чего-то сделать!');
end;
end;
Если попробуете вызвать метод Find с указанными параметрами, заменив остальные на EmptyParam, то получите исключение. Есть места в Excel Type Library, работающие с ошибками. В таких случаях используем приведенный ниже прием:
procedure TForm1.btnFindClick(Sender: TObject);
var ISheet: Excel8TLB._Worksheet;
UsedRange, Range: OLEVariant;
FirstAddress: string;
begin
if Assigned(IWorkbook) then
try
ISheet := IWorkbook.Worksheets.Item['Лист1'] as Excel8TLB._Worksheet;
UsedRange := ISheet.UsedRange[0];
Range := UsedRange.Find(What:='Text', LookIn := xlValues, SearchDirection := xlNext);
if not VarIsEmpty(Range) thenbegin
FirstAddress := Range.Address;
repeat
Range.Interior.ColorIndex := 37;
Range := UsedRange.FindNext(After := Range);
until FirstAddress = Range.Address;
ShowExcel;
end;
except
raise Exception.Create('Не могу чего-то сделать!');
end;
end;
Перемещение данных между листами
Как перемещать данные между листами:
procedure TForm1.btnMoveDataClick(Sender: TObject);
var ISheetSrc, ISheetDst: Excel8TLB._Worksheet;
IRangeSrc, IRangeDst: Excel8TLB.Range;
begin
if Assigned(IWorkbook) then
try
ISheetSrc := IWorkbook.Worksheets.Item['Лист1'] as Excel8TLB._Worksheet;
ISheetDst :=
IWorkbook.Worksheets.Add(EmptyParam, ISheetSrc, 1, EmptyParam, 0) as _Worksheet;
IRangeSrc := ISheetSrc.Range['TestRange2', EmptyParam];
IRangeDst := ISheetDst.Range['D4', EmptyParam];
IRangeSrc.Copy(IRangeDst);
finally
IRangeDst := nil;
IRangeSrc := nil;
ISheetDst := nil;
ISheetSrc := nil;
end;
end;
Метод Copy интерфейса Range принимает в качестве параметра любой другой Range. Причем, совсем не важно, совпадают ли размеры источника и получателя, так как данные копируются начиная с левой верхней ячейки получателя в количестве, определенном размером источника. Код, который выполняет ту же задачу, но через буфер обмена:
procedure TForm1.btnMoveDataClick(Sender: TObject);
var ISheetSrc, ISheetDst: Excel8TLB._Worksheet;
IRangeSrc, IRangeDst: Excel8TLB.Range;
begin
if Assigned(IWorkbook) then
try
ISheetSrc := IWorkbook.Worksheets.Item['Лист1'] as Excel8TLB._Worksheet;
ISheetDst :=
IWorkbook.Worksheets.Add(EmptyParam, ISheetSrc, 1, EmptyParam, 0) as _Worksheet;
IRangeSrc := ISheetSrc.Range['TestRange2', EmptyParam];
IRangeDst := ISheetDst.Range[ 'D4', EmptyParam];
IRangeSrc.Copy(EmptyParam); // так кладем в Clipboard
ISheetDst.Paste(IRangeDst, EmptyParam, 0); // а вот так достаем оттуда
finally
IRangeDst := nil; IRangeSrc := nil; ISheetDst := nil; ISheetSrc := nil;
end;
end;
Типичные ошибки
Речь идет о тривиальном переносе данных с помощью обычного присваивания свойству ячейки Value нового значения. Первый переключатель на форме (с заголовком "Value :=") скрывает за собой вызов процедуры ToNewValue:
procedure TForm1.ToNewValue(ISheet: IxlWorksheet);
var Row, Column, i: integer;
begin
tblCust.First;
Row := StartRow;
tblCust.First;
while not tblCust.EOF do begin
Column := StartColumn;
for i := 0 to tblCust.Fields.Count - 1 do begin
ISheet.Cells.Item[Row, Column].Value := FieldToVariant(tblCust.Fields[i]);
Inc(Column);
end;
Inc(Row);
tblCust.Next;
end;
end;
Это обычный проход по всей таблице (First; while not EOF do Next;) и по всем ее полям (вложенный for). Но! Во-первых, в этом примере начинаем переносить данные с ячейки, определенной константами StartRow и StartColumn. Во-вторых, ожидаемый оператор присваивания "Cell.Value := Field.Value" заменен на "Cell.Value := FieldToVariant(Field)". То есть, в отличие от классического примера используется функция получения вариантного значения поля.
Если присмотреться к исходному тексту функции FieldToVariant,
function FieldToVariant(Field: TField): OLEVariant;
begin
Result := '';
case Field.DataType of
ftString, ftFixedChar, ftWideString, ftMemo, ftFmtMemo: Result := '''' + Field.AsString;
ftSmallint, ftInteger, ftWord, ftLargeint, ftAutoInc: Result := Field.AsInteger;
ftFloat, ftCurrency, ftBCD: Result := Field.AsFloat;
ftBoolean: Result := Field.AsBoolean;
ftDate, ftTime, ftDateTime: Result := Field.AsDateTime;
end;
end;
то можно разглядеть причину. Кроме достаточно глупых "AsInteger", "AsFloat" и пр. добавлены в начало значения строковых полей одиночную кавычку. Ввод в формулу ячейки первым символом одиночной кавычки заставляет Excel принимать остальные символы как текст. Но, это касается формул ячеек, а не их значений!? Попробуйте убрать добавление этой кавычки и перекомпилировать проект. Конечно, и в этом варианте все будет работать. Но отредактируйте поле "Company" в первой записи таблицы, введя туда строку "3/7". Не увидите в полученной книге вместо этой строки дату или результат деления? Столь же некорректный результат будет получен и при попытке передачи строки "0001", которая будет воспринята как число 1. Благо, одиночная кавычка в начале строки решает эту проблему даже при присваивании в Value (а не в Formula).
Львиная доля времени уходит на вызовы интерфейсов внешнего COM-сервера. И, не смотря на то, что мы используем ранее связывание с библиотекой типов. Задача - избавиться от вызова Cell.Value в цикле. И это решаемо с помощью вариантных массивов:
procedure TForm1.ToVarArray(ISheet: IxlWorksheet);
var Row, Column, i: integer;
IR1, IR2: IxlRange;
Arr: OLEVariant;
begin
Arr := VarArrayCreate([1, tblCust.RecordCount, 1, tblCust.Fields.Count], varVariant);
Row := 1;
tblCust.First;
whilenot tblCust.EOF dobegin
Column := 1;
for i := 0 to tblCust.Fields.Count - 1 dobegin
Arr[Row, Column] := FieldToVariant(tblCust.Fields[i]);
Inc(Column);
end;
Inc(Row);
tblCust.Next;
end;
IDispatch(IR1) := ISheet.Cells.Item[StartRow, StartColumn];
IDispatch(IR2) := ISheet.Cells.Item[StartRow + tblCust.RecordCount - 1,
StartColumn + tblCust.Fields.Count - 1];
ISheet.Range[IR1, IR2].Value := Arr;
end;
Здесь используется вариантный массив Arr, который предварительно создается с размерами таблицы (количество записей на количество полей). Благо Microsoft построила очень четкую схему работы с вариантными массивами и интерфейсами, их "понимающими". Из кода видно, что по-прежнему проходим всю таблицу, запоминая в элементах массива значения полей, полученных из вышеописанной функции FieldToVariant. Используем варианты, и проблема строки "3/7" остается. Последние три строки процедуры позволяют получить верхнюю левую и нижнюю правую ячейки области, в которую будут перенесены данные. А, затем, одним присваиванием в "Область.Value" переносим данные из массива в ячейки этой области.
XL Report очень долго использовал только буфер обмена для передачи данных из приложения в Excel. Дело в том, что при таком варианте достигается практически максимальная скорость переноса данных. Дело в том, что в буфер обмена "кладется" длинная строка, содержащая строковые значения полей набора данных (AsString), разделенные символом табуляции. Записи отделяются друг от друга переводом строки (#10). Собственно, этот формат известен в научных кругах как CSV (разделитель между значениями).
Для того чтобы "выжать" из Excel максимальное быстродействие, приходится использовать определенные методы и свойства его интерфейсов. А их использование не оставляет ничего, кроме как уничтожение содержимого буфера обмена. Решение по переносу данных - CSV:
procedure TForm1.ToCSV(ISheet: IxlWorksheet);
var i: integer;
IR1, IR2: IxlRange;
Buff: String;
begin
Buff := '';
tblCust.First;
whilenot tblCust.EOF dobegin
for i := 0 to tblCust.Fields.Count - 1 dobegin
Buff := Buff + FieldToStr(tblCust.Fields[i]);
if i < (tblCust.Fields.Count - 1) then
Buff := Buff + #9;
end;
tblCust.Next;
ifnot tblCust.EOF then
Buff := Buff + #10;
end;
BufferToClipboard(Buff);
try
IDispatch(IR1) := ISheet.Cells.Item[StartRow, StartColumn];
IDispatch(IR2) := ISheet.Cells.Item[StartRow + tblCust.RecordCount - 1,
StartColumn + tblCust.Fields.Count - 1];
OLEVariant(ISheet.Range[IR1, IR2]).PasteSpecial;
finally
Clipboard.Clear;
end;
end;
В строковый буфер Buff собирается вся таблица. Строковые значения полей разделяем символом табуляции, а в "конце" записи добавляем перевод строки. Все значения заключаем дополнительно в двойные кавычки. Затем вызовом процедуры BufferToClipboard помещаем содержимое этой переменной в буфер обмена и делаем вызов PasteSpecial для области, в которую будут помещены данные.
Во-первых, процедура BufferToClipboard - не стандартная. Она создана как альтернатива методу SetTextBuf класса TClipboard. В VCL доступна глобальная переменная Clipboard, экземпляр класса TClipboard, инкапсулирующего свойства и методы доступа к этому самому буферу обмена. И, собственно, вызов SetTextBuf позволяет поместить строку в буфер.
SetTextBuf помещает в буфер обмена текст в формате CF_TEXT - обычный текст с однобайтовым представлением символов, что не хорошо. Точнее, это совсем не хорошо, если работаете с "русскими буквами" на разных операционных системах от MS, причем, разных с точки зрения локализации. Именно тогда и возникают у пользователей вопросы при попытке прочитать некий набор "закорючек", отдаленно напоминающих письмена племени зибару. Поэтому предпочтительно UNICODE, вставка которого в буфер обмена и реализована в этой процедуре.
UNICODE - это первая проблема, которая была решена. Но при использовании CSV есть и другие. И, главная, из них - "3/7". Без вмешательства в содержимое поля (аналогично добавлению одиночной кавычки при вариантах) нельзя обойти никак.
Один из переключателей вариантов имеет название, состоящее из сочетания букв - DDE. Тем не менее, решим "главную" проблему - сохранение содержимого буфера обмена:
procedure TForm1.ToDDE(ISheet: IxlWorksheet);
var xlDDE: TDDEClientConv;
i: integer;
IR1, IR2, IRange: IxlRange;
Buff: string;
begin
Buff := '';
tblCust.First;
whilenot tblCust.EOF dobegin
for i := 0 to tblCust.Fields.Count - 1 dobegin
Buff := Buff + FieldToStr(tblCust.Fields[i]);
if i < (tblCust.Fields.Count - 1) then
Buff := Buff + #9;
end;
tblCust.Next;
ifnot tblCust.EOF then
Buff := Buff + #10;
end;
IDispatch(IR1) := ISheet.Cells.Item[StartRow, StartColumn];
IDispatch(IR2) := ISheet.Cells.Item[StartRow + tblCust.RecordCount - 1,
StartColumn + tblCust.Fields.Count - 1];
IRange := ISheet.Range[IR1, IR2];
xlDDE := TDDEClientConv.Create(Self);
try
if xlDDE.SetLink('EXCEL', ISheet.Name) then
xlDDE.PokeData(OLEVariant(IRange).Address[ReferenceStyle:=xlR1C1], PChar(Buff));
finally
xlDDE.Free;
end;
end;
В этой процедуре проходим по всей таблице, собирая в строковый буфер значения полей, разделенные символом табуляции. Записи же разделяются символом перевода строки. Затем я получаю интерфейс на область, куда необходимо поместить данные из таблицы. Это первая часть кода. Далее - самое интересное.
Переменная xlDDE используется для доступа к Excel посредством DDE. Если опустить теорию, напрямую обратившись к практике, то можно увидеть следующий алгоритм использования. Во-первых, создается экземпляр класса TDDEClientConv. Во-вторых, вызовом SetLink происходит соединение через DDE с запущенным Excel. SetLink возвращает true, если это соединение успешно. А далее происходит вызов метода PokeData, одним из параметров которого является строковый буфер Buff. Второй параметр - это адрес области в формате R1C1. Скорость сравнима с CSV через буфер обмена. Плюс, здесь буфер обмена совсем не используем.
Попробуйте несколько раз подряд быстро нажать кнопку "Send data" с этим вариантом передачи данных. Excel просто виснет. Точнее, он что-то делает, загружая на все сто процессор. Почему это происходит? Смутила вот эта строка в реализации TDDEClientConv:
hdata := DdeClientTransaction(Pointer(hszDat), DWORD(-1), FConv, hszItem,
FDdeFmt, XTYP_POKE, TIMEOUT_ASYNC, nil);
Точнее параметр TIMEOUT_ASYNC, позволяющий передавать данные асинхронно. Вот и сыплется Excel, не выдерживая реализации DDE-клиента от Borland/Inprise. Делаем потомка класса TDDEClientConv, добавив ему новый метод xlPokeData, в котором просто заменяем строку:
Const xddeTransactionTimeOut = 100000;
…
hdata := DdeClientTransaction(Pointer(hszDat), DWORD(-1), Conv, hszItem,
CF_XLTABLE, XTYP_POKE, xddeTransactionTimeOut, nil);
…
Контрольное задание
Индивидуально (согласно заданию преподавателя) сформировать документ MSExcel и подключить к BorlandDelphi. Прописать функциональные кнопки аналогично приведенным формам и алгоритмам.
|
|
|
Скачать 2.1 Mb.