Справочник функций

Ваш аккаунт

Войти через: 
Забыли пароль?
Регистрация
Информацию о новых материалах можно получать и без регистрации:

Последние темы форума

Показать новые сообщения »

Почтовая рассылка

Подписчиков: 11853
Последний выпуск: 19.06.2015

Печать из Delphi в Excel по шаблону

Автор: ООО "РИЛИО"

Прилагается исходный код компонента ExcelView и процедуры экспорта и печати по шаблону в Excel для Delphi 2010/XE/XE2. Доступна полная версия с примерами использования.

Зачем это нужно?

Excel в современном офисе фактически стал стандартом для ввода и анализа данных, создания итоговых отчетов и презентаций. В первую очередь, благодаря наглядности подхода и простоте освоения. Создать "табличку" с нужными автоматическими расчетами, добавить промежуточные итоги по нескольким критериям и построить по этим итогам круговую диаграмму - все это можно сделать без специальной подготовки, легко и непринужденно.

Поэтому вполне закономерно, что Excel широко используется и для разработки различных печатных форм. Хотя по своим возможностям он уступает специализированным генераторам отчетов, уже практически для всех типовых документов можно найти готовые Excel-шаблоны, от коммерческого предложения до товарно-транспортной накладной по форме 1-Т (http://blanker.ru/doc/38)

Что и как экспортировать?

Предполагается, что нам нужно заполнять предварительно созданные шаблоны Excel. Под шаблонами подразумеваются обычные Excel-файлы, в которых отдельные ячейки и области обозначаются именами переменных. Туда и будут вставляться наши данные.

В шаблоне могут использоваться в качестве переменных:

  • все published свойства формы-владельца
  • все компоненты, принадлежащие форме-владельцу, и их published свойства
  • все наборы данных (наследники TDataSet) обрабатываются специальным образом, в шаблон подставляются значения их полей

Готовые решения на основе шаблонов

Компоненты для вывода в Excel довольно легко найти в интернете, например:

Do It Yourself

Библиотеки компонентов всем хороши (кроме стоимости, конечно), но даже наличие исходных текстов не всегда спасает от возможных неприятностей. Проблема в том, что кода становится слишком много. Например, один из лучших (на мой взгляд) - FlexCelReport - это 916 Кб в 174 исходных файлах. Переносить этот проект на современные версии Delphi становится проблематично.

В таких случаях остается вариант написания процедуры или компонента самостоятельно. В качестве стартовой точки для ознакомления можно рекомендовать http://www.webdelphi.ru/2009/08/rabota-s-excel-v-delphi-osnovy-osnov/http://www.codenet.ru/progr/delphi/stat/export-to-excel.php и т.д.

Таблицы и поля в шаблонах

У всех компонентостроителей - свои правила записи переменных в шаблонах. В FlexCelReport - это именованные диапазоны с двумя подчеркиваниями "__MAIN__" и переменные в ячейках вида ##DataSetName##FieldName, в ARExcelReport - <#table:DataSetName> ... <#table> и т.д.

Мы хотим еще проще. Только FieldName и ничего лишнего.

А где задается DataSet?

В первой колонке. Отведем всю колонку под служебную информацию, благо в Экселе их (колонок) и так более чем достаточно. При выводе будем эту колонку скрывать.

Еще одно допущение - если мы хотим вывести все записи из DataSet-а в виде таблицы, ставим перед его именем звездочку (*tblOrders). Без звездочки будут выводиться только значения полей текущей записи.

шаблон ExcelView

Свойства и компоненты в шаблонах

Для вывода в шаблоне published свойства текущей формы запишем в ячейке имя этого свойства в квадратных скобках: [Caption], [Tag]. Свойства компонентов формы записываются с именем компонента через точку: [Memo1.Lines]. Поддерживаются (пока) свойства следующих типов: Integer, Int64, String, Double, Boolean, TStrings.

Реализация

Весь код находится в файле ExcelView.pas (7 Кб). Компонент TExcelView имеет единственное published свойство TemplateFileName - это имя файла шаблона. Метод Show открывает Excel и запускает процесс экспорта.

Можно и не устанавливать компонент в палитру, а сразу выполнить процедуру

Код:
procedure ShowExcelView(Owner: TComponent; FileName: TFileName);

Обратите внимание на параметр Owner! Это тот компонент (форма, датамодуль), чьи свойства, компоненты, датасеты и будут экспортироваться в Excel.

Взаимодействие с Excel происходит через OLE:

Код:
Excel := CreateOleObject('Excel.Application');

Для вывода набора данных сначала формируется вариантный массив:

Код:
ArrayData := VarArrayCreate([1, DataSet.RecordCount, 1, FieldList.Count], varVariant);
y := 1;
while not DataSet.Eof do
begin
 z := 1;
 for i := 0 to FieldList.Count-1 do begin
 if FieldList[i]='' then ArrayData[y, z] :=''
 else begin
 if DataSet.FieldByName(FieldList[i]).DataType=ftFloat then
 ArrayData[y, z] := DataSet.FieldByName(FieldList[i]).AsFloat
 else ArrayData[y, z] := DataSet.FieldByName(FieldList[i]).Value;
 end;
 inc(z);
 end;
 DataSet.Next;
 inc(y);
end;

А потом уже вставляется в нужное место:

Код:
Range.Value := ArrayData;

Для вывода свойств используется модуль Rtti:

Код:
c := TRttiContext.Create;
t:=c.GetType(cmp.ClassInfo);
p:=t.GetProperty(PropName);
if p <> nil then begin
 IsNumeric:=false;
 if p.PropertyType.ToString = 'TStrings' then PropValue:=p.GetValue(cmp).AsType.Text
 else if p.PropertyType.ToString = 'Boolean' then PropValue:=BoolToStr(p.GetValue(cmp).AsBoolean,true)
 else
 case p.PropertyType.TypeKind of
 tkInteger,
 tkInt64 : begin
 PropValue := IntToStr(p.GetValue(cmp).AsInteger);
 IsNumeric:=true;
 end;
 tkString,
 tkUString,
 tkLString : PropValue := p.GetValue(cmp).AsString;
 tkFloat : begin
 PropValue := FloatToStr(p.GetValue(cmp).AsExtended);
 IsNumeric:=true;
 end;
 else PropValue := '';
 end;
 if IsNumeric and (Trim(Copy(st,1,i1-1))='') and (Trim(Copy(st,i2+1,length(st)))='') then
 Sheet.Cells[Row, Col]:=StrToFloat(PropValue)
 else Sheet.Cells[Row, Col]:=Copy(st,1,i1-1)+PropValue+Copy(st,i2+1,length(st));
end;
c.Free;

Из за использования модулей Rtti и TypInfo компонент не работает в Delphi младше 2010. Можно либо удалить эти ссылки и весь метод ProcessProperty, либо переписать его для младших версий Delphi (см. http://delphi7.org/lit/faq/1618.php)

Исходный код

Код:
//////////////////////////////////////////////////////////////
// ExcelView v 0.1 //
// Freeware component for Delphi 2010/XE/XE2 //
// //
// Copyright (c) 2012 RILIO (http://rilio.net) //
// //
// Software distributed on an "AS IS" basis, //
// WITHOUT WARRANTY OF ANY KIND, either express or implied. //
// //
//////////////////////////////////////////////////////////////
unit ExcelView;
interface
uses
 SysUtils, Classes, DB;
type
 TExcelView = class(TComponent)
 private
 FTemplateFileName: TFileName;
 procedure SetTemplateFileName(const Value: TFileName);
 procedure ProcessSheet(Sheet: Variant);
 procedure ProcessDataSet(Sheet: Variant; Row: integer);
 procedure ProcessMultipleRecords(Sheet: Variant; Row: integer; DataSet: TDataSet);
 procedure ProcessProperty(Sheet: Variant; Row: integer; Col: integer);
 protected
 public
 procedure Show;
 published
 property TemplateFileName: TFileName read FTemplateFileName write SetTemplateFileName;
 end;
procedure ShowExcelView(Owner: TComponent; FileName: TFileName);
procedure Register;
implementation
uses Variants, ActiveX, ComObj, Rtti, TypInfo;
procedure ShowExcelView(Owner: TComponent; FileName: TFileName);
begin
 with TExcelView.Create(Owner) do begin
 TemplateFileName:=FileName;
 Show;
 Free;
 end;
end;
function IsExcelInstalled: boolean;
var
 ClassID: TCLSID;
begin
 Result := CLSIDFromProgID(PWideChar(WideString('Excel.Application')), ClassID) = S_OK;
end;
procedure Register;
begin
 RegisterComponents('RILIO', [TExcelView]);
end;
{ TExcelView }
procedure TExcelView.ProcessDataSet(Sheet: Variant; Row: integer);
var DataSetName: string;
 MultipleRecords: boolean;
 DataSet: TDataSet;
 i: integer;
 FieldName: string;
begin
 DataSetName:=Sheet.Cells[Row,1];
 MultipleRecords:=DataSetName[1]='*';
 if MultipleRecords then
 DataSetName:=Copy(DataSetName,2,length(DataSetName));
 DataSet:=TDataSet(Owner.FindComponent(DataSetName));
 if DataSet <> nil then
 if MultipleRecords and (DataSet.RecordCount > 1) then ProcessMultipleRecords(Sheet,Row,DataSet) else
 for i := 2 to Sheet.UsedRange.Columns.Count do begin
 FieldName:=string(Sheet.Cells[Row,i]);
 if DataSet.FindField(FieldName) <> nil then begin
 if DataSet.FieldByName(FieldName).DataType=ftFloat then
 Sheet.Cells[Row,i]:=DataSet.FieldByName(FieldName).AsFloat
 else Sheet.Cells[Row,i]:=DataSet.FieldByName(FieldName).AsString;
 end;
 end;
end;
procedure TExcelView.ProcessMultipleRecords(Sheet: Variant; Row: integer; DataSet: TDataSet);
var i,z,y: integer;
 ArrayData : Variant;
 FieldName: string;
 FieldList: TStringList;
 StartCol: integer;
 Cell1,Cell2,Cell3,Range,RowRange: OleVariant;
begin
 StartCol:=0;
 FieldList:=TStringList.Create;
 for i:=2 to Sheet.UsedRange.Columns.Count do begin
 FieldName:=string(Sheet.Cells[Row,i]);
 if DataSet.FindField(FieldName) <> nil then begin
 FieldList.Add(FieldName);
 if StartCol=0 then StartCol:=i;
 end else if StartCol <> 0 then FieldList.Add('');
 end;
 FieldList.Text:=Trim(FieldList.Text);
 DataSet.Last;
 DataSet.First;
 ArrayData := VarArrayCreate([1, DataSet.RecordCount, 1, FieldList.Count], varVariant);
 y := 1;
 while not DataSet.Eof do
 begin
 z := 1;
 for i := 0 to FieldList.Count-1 do begin
 if FieldList[i]='' then ArrayData[y, z] :=''
 else begin
 if DataSet.FieldByName(FieldList[i]).DataType=ftFloat then
 ArrayData[y, z] := DataSet.FieldByName(FieldList[i]).AsFloat
 else ArrayData[y, z] := DataSet.FieldByName(FieldList[i]).Value;
 end;
 inc(z);
 end;
 DataSet.Next;
 inc(y);
 end;
 for i := 1 to DataSet.RecordCount-1 do
 Sheet.Rows[Row+1].Insert;
 Cell1 := Sheet.Cells[Row, StartCol];
 Cell2 := Sheet.Cells[Row, StartCol + FieldList.Count-1];
 Cell3 := Sheet.Cells[Row + DataSet.RecordCount-1, StartCol + FieldList.Count-1];
 RowRange := Sheet.Range[Cell1, Cell2];
 Range := Sheet.Range[Cell1, Cell3];
 if DataSet.RecordCount=0 then RowRange.Value:='' else begin
 RowRange.AutoFill(Range, 3);
 Range.WrapText:= True;
 Range.VerticalAlignment := 1;
 Range.Value := ArrayData;
 end;
 FieldList.Free;
end;
procedure TExcelView.ProcessProperty(Sheet: Variant; Row, Col: integer);
var st, PropName, PropValue: string;
 i1, i2, dotpos: integer;
 cmp: TComponent;
 c : TRttiContext;
 t : TRttiType;
 p : TRttiProperty;
 IsNumeric: boolean;
begin
 st:=string(Sheet.Cells[Row, Col]);
 i1:=Pos('[',st);
 i2:=Pos(']',st);
 PropName:=Copy(st,i1+1,i2-i1-1);
 dotpos:=Pos('.',PropName);
 if dotpos <> 0 then begin
 cmp:=Owner.FindComponent(Copy(PropName,1,dotpos-1));
 PropName:=Copy(PropName,dotpos+1,length(PropName));
 end else cmp:=Owner;
 if cmp <> nil then begin
 c := TRttiContext.Create;
 t:=c.GetType(cmp.ClassInfo);
 p:=t.GetProperty(PropName);
 if p <> nil then begin
 IsNumeric:=false;
 if p.PropertyType.ToString = 'TStrings' then PropValue:=p.GetValue(cmp).AsType<TStrings>.Text
 else if p.PropertyType.ToString = 'Boolean' then PropValue:=BoolToStr(p.GetValue(cmp).AsBoolean,true)
 else
 case p.PropertyType.TypeKind of
 tkInteger,
 tkInt64 : begin
 PropValue := IntToStr(p.GetValue(cmp).AsInteger);
 IsNumeric:=true;
 end;
 tkString,
 tkUString,
 tkLString : PropValue := p.GetValue(cmp).AsString;
 tkFloat : begin
 PropValue := FloatToStr(p.GetValue(cmp).AsExtended);
 IsNumeric:=true;
 end;
 else PropValue := '';
 end;
 if IsNumeric and (Trim(Copy(st,1,i1-1))='') and (Trim(Copy(st,i2+1,length(st)))='') then
 Sheet.Cells[Row, Col]:=StrToFloat(PropValue)
 else Sheet.Cells[Row, Col]:=Copy(st,1,i1-1)+PropValue+Copy(st,i2+1,length(st));
 end;
 c.Free;
 end;
end;
procedure TExcelView.ProcessSheet(Sheet: Variant);
var
 i,j,Cols,Rows: integer;
begin
 Sheet.Activate;
 Rows:=Sheet.UsedRange.Rows.Count;
 Cols:=Sheet.UsedRange.Columns.Count;
 for i := 1 to Rows+1 do begin
 for j := 1 to Cols+1 do
 if Pos('[',string(Sheet.Cells[i,j])) <> 0 then
 ProcessProperty(Sheet,i,j);
 end;
 for i := 1 to Rows+1 do begin
 if string(Sheet.Cells[i,1]) <> '' then
 ProcessDataSet(Sheet,i);
 end;
 Sheet.Columns[1].Hidden:=true;
end;
procedure TExcelView.SetTemplateFileName(const Value: TFileName);
begin
 FTemplateFileName := Value;
end;
procedure TExcelView.Show;
var
 Excel, Book, Sheet, ArrayData : Variant;
 i: integer;
 ClassID: TCLSID;
begin
 if not FileExists(TemplateFileName) then raise Exception.Create('Template file "'+TemplateFileName+'" not found');
 if CLSIDFromProgID(PWideChar(WideString('Excel.Application')), ClassID) <> S_OK then raise Exception.Create('MS Excel application not found');
 try
 Excel := CreateOleObject('Excel.Application');
 Excel.EnableEvents := False;
 Excel.Visible:=false;
 Book := Excel.Workbooks.Add(TemplateFileName);
 for i := 1 to Book.Sheets.Count do
 ProcessSheet(Book.Sheets.Item[i]);
 Book.Sheets.Item[1].Activate;
 finally
 Excel.EnableEvents := true;
 Excel.Visible:=true;
 Excel.Visible:=false;
 Excel.Visible:=true;
 end;
end;
end.

Оставить комментарий

Комментарий:
можно использовать BB-коды
Максимальная длина комментария - 4000 символов.
 

Комментарии

1.
86K
26 ноября 2012 года
SnowLeo
8 / / 26.11.2012
+3 / -0
Мне нравитсяМне не нравится
28 ноября 2012, 21:32:46
Спасибо! Полезная вещь.
Реклама на сайте | Обмен ссылками | Ссылки | Экспорт (RSS) | Контакты
Добавить статью | Добавить исходник | Добавить хостинг-провайдера | Добавить сайт в каталог