Печать из 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/
Дайджест новых статей по интернет-маркетингу на ваш email
Новые статьи и публикации
- 2024-09-30 » Как быстро запустить Laravel на Windows
- 2024-09-25 » Next.js
- 2024-09-05 » OpenAI рассказал, как запретить ChatGPT использовать содержимое сайта для обучения
- 2024-08-28 » Чек-лист: как увеличить конверсию интернет-магазина на примере спортпита
- 2024-08-01 » WebSocket
- 2024-07-26 » Интеграция с Яндекс Еда
- 2024-07-26 » Интеграция с Эквайринг
- 2024-07-26 » Интеграция с СДЕК
- 2024-07-26 » Интеграция с Битрикс-24
- 2024-07-26 » Интеграция с Travelline
- 2024-07-26 » Интеграция с Iiko
- 2024-07-26 » Интеграция с Delivery Club
- 2024-07-26 » Интеграция с CRM
- 2024-07-26 » Интеграция с 1C-Бухгалтерия
- 2024-07-24 » Что такое сторителлинг: техники и примеры
- 2024-07-17 » Ошибка 404: что это такое и как ее использовать для бизнеса
- 2024-07-03 » Размещайте прайс-листы на FarPost.ru и продавайте товары быстро и выгодно
- 2024-07-01 » Профилирование кода в PHP
- 2024-06-28 » Изучаем ABC/XYZ-анализ: что это такое и какие решения с помощью него принимают
- 2024-06-17 » Зачем вам знать потребности клиента
- 2024-06-11 » Что нового в работе Яндекс Метрики: полный обзор обновления
- 2024-06-11 » Поведенческие факторы ранжирования в Яндексе
- 2024-06-11 » Скорость загрузки сайта: почему это важно и как влияет на ранжирование
- 2024-05-27 » Подборка сервисов для расшифровки аудио в текст
- 2024-05-27 » PostgreSQL 16. Изоляция транзакций. Часть 2
- 2024-05-06 » Как настраивать конверсионные стратегии: работа над ошибками
- 2024-04-22 » Комментирование кода и генерация документации в PHP
- 2024-04-22 » SEO в России и на Западе: в чем основные отличия
- 2024-04-22 » SEO для международного масштабирования
- 2024-04-22 » Как использовать XML-карты для продвижения сайта
Кто мало хочет, тот дешево стоит |
Мы создаем сайты, которые работают! Профессионально обслуживаем и продвигаем их , а также по всей России и ближнему зарубежью с 2006 года!
Как мы работаем
Заявка
Позвоните или оставьте заявку на сайте.
Консультация
Обсуждаем что именно Вам нужно и помогаем определить как это лучше сделать!
Договор
Заключаем договор на оказание услуг, в котором прописаны условия и обязанности обеих сторон.
Выполнение работ
Непосредственно оказание требующихся услуг и работ по вашему заданию.
Поддержка
Сдача выполненых работ, последующие корректировки и поддержка при необходимости.