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

procedure ShowExcelView(Owner: TComponent; FileName: TFileName);

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;

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;

//////////////////////////////////////////////////////////////
// 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.