CodeNet / Языки программирования / Delphi & Kylix / Печать и отчеты

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

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

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

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

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

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

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

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

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

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

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

TMS Flexcel Studio (http://www.tmssoftware.com/site/flexcel.asp) - $125
ARExcelReport (http://www.vector-ski.com/reports/arexcelreport_index.htm) - бесплатный для некоммечерского использования, стоимость исходников - $125
Don Excel Report (http://www.don-soft.com.ar/DonExcelReport/products.php) - $75
AfalinaSoft XL Report (http://www.afalinasoft.com/download-xl-report.html) - "будет open source через месяц-два", - написано в 2003 году. Увы...
FlexCelReport (http://www.freewebs.com/flexcel/) - бесплатный, в исходниках. Для Delphi 5/6/7. Сайт в настоящее время недоступен. При пересборке пакетов под Delphi 2010-XE2 необходимо вносить серьезные изменения.

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.

Ваш аккаунт

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

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

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

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

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

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

Do It Yourself

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

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

Реализация

Исходный код

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

Комментарии

Комментарий: можно использовать BB-коды Максимальная длина комментария - 4000 символов.	CodeNet ВКонтакте Facebook Twitter Google Яндекс Чтобы оставить комментарий, необходимо авторизоваться. Можно ввести логин и пароль, или авторизоваться через социальные сети.

Ваш аккаунт

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

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

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

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

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

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

Do It Yourself

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

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

Реализация

​Исходный код

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

Комментарии

Исходный код