Печать из 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). Без звездочки будут выводиться только значения полей текущей записи.

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

Для вывода в шаблоне 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;
whilenot DataSet.Eofdo
begin
 z :=1;
 for i :=0to FieldList.Count-1dobegin
 if FieldList[i]=''then ArrayData[y, z]:=''
 elsebegin
 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 <> nilthenbegin
 IsNumeric:=false;
 if p.PropertyType.ToString='TStrings'then PropValue:=p.GetValue(cmp).AsType.Text
 elseif p.PropertyType.ToString='Boolean'then PropValue:=BoolToStr(p.GetValue(cmp).AsBoolean,true)
 else
 case p.PropertyType.TypeKindof
 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)dobegin
 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 <> nilthen
 if MultipleRecords and(DataSet.RecordCount > 1)then ProcessMultipleRecords(Sheet,Row,DataSet)else
 for i :=2to Sheet.UsedRange.Columns.Countdobegin
 FieldName:=string(Sheet.Cells[Row,i]);
 if DataSet.FindField(FieldName) <> nilthenbegin
 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:=2to Sheet.UsedRange.Columns.Countdobegin
 FieldName:=string(Sheet.Cells[Row,i]);
 if DataSet.FindField(FieldName) <> nilthenbegin
 FieldList.Add(FieldName);
 if StartCol=0then StartCol:=i;
 endelseif StartCol <> 0then FieldList.Add('');
 end;
 FieldList.Text:=Trim(FieldList.Text);
 DataSet.Last;
 DataSet.First;
 ArrayData := VarArrayCreate([1, DataSet.RecordCount,1, FieldList.Count], varVariant);
 y :=1;
 whilenot DataSet.Eofdo
 begin
 z :=1;
 for i :=0to FieldList.Count-1dobegin
 if FieldList[i]=''then ArrayData[y, z]:=''
 elsebegin
 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 :=1to DataSet.RecordCount-1do
 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=0then RowRange.Value:=''elsebegin
 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 <> 0thenbegin
 cmp:=Owner.FindComponent(Copy(PropName,1,dotpos-1));
 PropName:=Copy(PropName,dotpos+1,length(PropName));
 endelse cmp:=Owner;
 if cmp <> nilthenbegin
 c := TRttiContext.Create;
 t:=c.GetType(cmp.ClassInfo);
 p:=t.GetProperty(PropName);
 if p <> nilthenbegin
 IsNumeric:=false;
 if p.PropertyType.ToString='TStrings'then PropValue:=p.GetValue(cmp).AsType<TStrings>.Text
 elseif p.PropertyType.ToString='Boolean'then PropValue:=BoolToStr(p.GetValue(cmp).AsBoolean,true)
 else
 case p.PropertyType.TypeKindof
 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 :=1to Rows+1dobegin
 for j :=1to Cols+1do
 if Pos('[',string(Sheet.Cells[i,j])) <> 0then
 ProcessProperty(Sheet,i,j);
 end;
 for i :=1to Rows+1dobegin
 ifstring(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
 ifnot FileExists(TemplateFileName)thenraise Exception.Create('Template file "'+TemplateFileName+'" not found');
 if CLSIDFromProgID(PWideChar(WideString('Excel.Application')), ClassID) <> S_OK thenraise 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 :=1to Book.Sheets.Countdo
 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.

Источник: http://feedproxy.google.com/~r/codenet/read/~3/9LmkrTVGj0o/

Читать комменты и комментировать

Добавить комментарий / отзыв



Защитный код
Обновить

Печать из Delphi в Excel по шаблону | | 2012-10-26 00:09:45 | | Программирование | | Автор: ООО РИЛИОПрилагается исходный код компонента ExcelView и процедуры экспорта и печати по шаблону в Excel для Delphi 2010/XE/XE2. Доступна полная версия с примерами использования.Зачем это нужно | РэдЛайн, создание сайта, заказать сайт, разработка сайтов, реклама в Интернете, продвижение, маркетинговые исследования, дизайн студия, веб дизайн, раскрутка сайта, создать сайт компании, сделать сайт, создание сайтов, изготовление сайта, обслуживание сайтов, изготовление сайтов, заказать интернет сайт, создать сайт, изготовить сайт, разработка сайта, web студия, создание веб сайта, поддержка сайта, сайт на заказ, сопровождение сайта, дизайн сайта, сайт под ключ, заказ сайта, реклама сайта, хостинг, регистрация доменов, хабаровск, краснодар, москва, комсомольск |
 
Поделиться с друзьями: