OpenExcelProject

[knat]

Пытаюсь создать Excel-отчет, включающий в себя несколько slk-форм. Сделала, как "книжка пишет", OpenExcelProject('имя-файла'); СloseExcelProject;
Компилируется тихо, не ругается. Однако при запуске отчетов требует от меня файл x.slk. и не формирует ни файлов с отчетами по отдельности, ни результирующей книги. Подпихнула ей пустой файл x.slk - она мне его и показывает после формирования отчетов, пустой...
Если у кого-то есть опыт - подскажите, плиз, что она от меня хочет или какие у меня могут быть ошибки.

[m0p3e]

Используй xl* функции. Работать намного прощи и возможностей существенно больше!

[knat]

А где про эти функции почитать?

[m0p3e]

см. Мыло.

[Grom]

MOR3E
Пришли и мне пожалуйста
sionizmu_net@pisem.net

[hope]

И мне, плз! hope@sitno.mgn.ru

[m0p3e]

Отправил.
Пример пока не доделаный. Планирую на следующей неделе его закончить.

[GTHack]

если не затруднит сюда тоже
GTHack@farm.vector.nsc.ru
Заранее thank !

[Бухгалтер Алексей]

и мне тоже, Pls!!
sas2002@pochtamt.ru
Спасибо!

[m0p3e]

Вышлю сегодня/завтра.

[Nuts]

unit ExcelExp;

interface
uses ExRegist, AtString, ComUse;

const

{ Variant type codes }

varEmpty = $0000; varNull = $0001;
varSmallint = $0002; varInteger = $0003;
varSingle = $0004; varDouble = $0005;
varCurrency = $0006; varDate = $0007;
varOleStr = $0008; varDispatch = $0009;
varError = $000A; varBoolean = $000B;
varVariant = $000C; varUnknown = $000D;
varByte = $0011; varString = $0100;
varTypeMask = $0FFF; varArray = $2000;
varByRef = $4000;

{ TVarRec.VType values }

vtInteger = 0; vtBoolean = 1;
vtChar = 2; vtExtended = 3;
vtString = 4; vtPointer = 5;
vtPChar = 6; vtObject = 7;
vtClass = 8; vtWideChar = 9;
vtPWideChar = 10; vtAnsiString = 11;
vtCurrency = 12; vtVariant = 13;
vtInterface = 14; vtWideString = 15;

Const
// Cell value alingment
stAlignCenter = -4108;
stAlignLeft = -4131;
stAlignRight = -4152;
stAlignFill = 5;

// Cell border styles
_cLBorder = 7;
_cRBorder = 10;
_cTBorder = 8;
_cBBorder = 9;
_cLWNone = 0;
_cLWThin = 2;
_cLWMedium = -4138;
_cLWContinuous= 1;
_cInsideV = 11;
_cInsideH = 12;

// Cell insert shift
_cShiftRight = -4161;
_cShiftDown = -4121;

// My border styles
LRBord = 3;
TBBord = 12;
LRTBBord = 15;
VBord = 16;
LRTBVBord = 31;
LRTBVHBord = 63;
LWeightNone = 0;
LWeightThin = 1;
LWeightMedium = 2;

Type
TExporter = Class(TObject)
Private
WBook : Variant;
FontSize : Word;
ShowApp : boolean;
NeedClose : boolean;
Function Digit2Char(Position : longint):String;
Public
ExApp : Variant;
FName : string;
Constructor Create(FileName : String; Visible : Boolean);
Function SetFontSize(Size : Word): Boolean;
Function SetCellSize(Size : word ; Raw, Col : word ; Direct : Char) : Boolean;
Function SetCellValue (Raw, Col : word ; Value : Variant;
Color : Longint; FontStyle: Byte) : Boolean;
Function SetCellFormula(Raw, Col : word ; Formula : String;
Color : Longint; FontStyle: Byte) : Boolean;
Function FormatArea(Arg1,Arg2 : string; Align : Char) : Boolean;
Function InsertRange(Area : string; _Shift_ : Char) : Boolean;

Function ShrinkCells(RawU, ColL, RawD, ColR : word) : Boolean;
Function AlignCells(RawU, ColL, RawD, ColR : word; Align : Char) : Boolean;
Function MergeCells(RawU, ColL, RawD, ColR : word) : Boolean;

Function FormatCells(RawU, ColL, RawD, ColR : word; Align : Char) : Boolean;
Function FrameCells(RawU, ColL, RawD, ColR, wBorder, wLineWeight : word) : Boolean;

Destructor Destroy; override;
end;

//Создание объекта Excel с именем файла FileName
Function CreateOleO(FileName : String; Visible : Boolean) : Boolean; Far;
// Заполнение ячейки строкой, FontStyle and 1 = 1 - BOLD
// and 2 = 2 - Italic
// and 4 = 4 - UnderLine
Function SetCellS (Raw, Col : word;
Value : String ;
Color : Longint;
FontStyle: Byte) : Boolean; Far;
// Заполнение ячейки вещественным типом, FontStyle and 1 = 1 - BOLD
// and 2 = 2 - Italic
// and 4 = 4 - UnderLine
Function SetCellF (Raw, Col : word;
Value : Double ;
Color : Longint;
FontStyle: Byte) : Boolean; Far;
// Заполнение ячейки целочисленным, FontStyle and 1 = 1 - BOLD
// and 2 = 2 - Italic
// and 4 = 4 - UnderLine
Function SetCellL (Raw, Col : word;
Value : LongInt;
Color : Longint;
FontStyle: Byte) : Boolean; Far;
// Заполнение ячейки формулой, FontStyle and 1 = 1 - BOLD
// and 2 = 2 - Italic
// and 4 = 4 - UnderLine
Function SetCellFm (Raw, Col : word;
Formula : String ;
Color : Longint;
FontStyle: Byte) : Boolean; Far;
// Формат области, заданной в стиле "R1":"R1"
Function FormatArea(Arg1,Arg2 : string; Align : Char) : Boolean; Far;
// вставка пустых ячеек со сдвигом вправо или вниз
Function InsertRange(Area : string; Shift : Char) : Boolean; Far;
//Установка размера ячейки (высота или ширина)
Function SetCellSize(Size : word ; Raw, Col : word ; Direct : Char) : Boolean; Far;
// Объединение ячеек
Function MergeCells(RawU, ColL, RawD, ColR : word) : Boolean;
// Формат ячеек - объединение+центрирование+размер
Function FormatCells(RawU, ColL, RawD, ColR : word; Align : Char) : Boolean; Far;
//обрамление области ячеек
Function FrameCells(RawU, ColL, RawD, ColR, wBorder, wLineWeight : word) : Boolean; Far;
//Установка размера шрифта. Размер действует до новой переустановки
Function SetFontS (Size : Word) : Boolean; Far;
// Разрушение Ole-объекта
Function KillOle : Boolean; Far;

Var
ExcelApp : TExporter;

Implementation

function VarIsNull(const V: Variant): Boolean;
begin
Result := TVarData(V).VType = varNull;
end;

function VarToStr(const V: Variant): string;
begin
if TVarData(V).VType <> varNull then Result := V else Result := '';
end;

Constructor TExporter.Create(FileName : String; Visible : Boolean);
var InMemory : IDispatch;
begin
Inherited Create;
if FileName = '' then
FName := 'Report.xls'
else FName := FileName;
NeedClose := False;
ExApp := varEmpty;
InMemory := GetActiveOleObject('Excel.Application');
if InMemory = nil then
begin
ExApp := CreateOleObject('Excel.Application');
NeedClose := True
end
else ExApp := InMemory;

If not VarIsNull(ExApp) then
begin
WBook := ExApp.Workbooks.Add;// new File
//ExApp.Workbooks[ExApp.Workbooks.Count].Activate;
ExApp.Visible := False;
ShowApp := Visible;
FontSize := 14;
end;
end;

Destructor TExporter.Destroy;
Begin
If Not VarIsNull(ExApp) then
begin
if Not VarIsNull(WBook) then
WBook.SaveAs(FName);

if NeedClose and not ShowApp then
ExApp.Quit
else ExApp.Visible := True;
end;
Inherited Destroy;
End;

Function TExporter.SetFontSize(Size : Word): Boolean;
Begin
Result := True;
If VarIsNull(ExApp) or VarIsNull(WBook) then
Result := False
else
Try
FontSize := Size;
Except
Result := False
end;
End;

Function TExporter.SetCellSize(Size : word ; Raw, Col : word ; Direct : Char) : Boolean;
Begin
Result := True;
If VarIsNull(ExApp) or VarIsNull(WBook) then
Result := False
else
Try
case Direct of
'c','C': ExApp.Range[Digit2Char(Col)+Long2Str(Raw),Digit2Char(Col)+Long2Str(Raw)].ColumnWidth := Size;
else ExApp.Range[Digit2Char(Col)+Long2Str(Raw),Digit2Char(Col)+Long2Str(Raw)].RowHeight := Size;
end;
Except
Result := False
end;
End;

Function TExporter.FrameCells;
var
sLR, sTD : string;
wLW : integer;
Begin
Result := False;
if ((RawU<=0) or (ColL<=0) or (RawD<=0) or (ColR<=0)) then
Exit;
if VarIsNull(ExApp) or VarIsNull(WBook) then
Exit;
Try
sLR := Digit2Char(ColL)+Long2Str(RawU);
sTD := Digit2Char(ColR)+Long2Str(RawD);

case wLineWeight of
LWeightNone : wLW := _cLWNone;
LWeightThin : wLW := _cLWThin;
LWeightMedium : wLW := _cLWMedium;
else wLW := _cLWMedium;
end;

if (wBorder and 1 = 1) then begin
ExApp.Range[sLR,sTD].Borders[_cLBorder].LineStyle := _cLWContinuous;
ExApp.Range[sLR,sTD].Borders[_cLBorder].Weight := wLW;
ExApp.Range[sLR,sTD].Borders[_cLBorder].ColorIndex:= 1;
end;
if (wBorder and 2 = 2) then begin
ExApp.Range[sLR,sTD].Borders[_cRBorder].LineStyle := _cLWContinuous;
ExApp.Range[sLR,sTD].Borders[_cRBorder].Weight := wLW;
ExApp.Range[sLR,sTD].Borders[_cRBorder].ColorIndex:= 1;
end;
if (wBorder and 4 = 4) then begin
ExApp.Range[sLR,sTD].Borders[_cTBorder].LineStyle := _cLWContinuous;
ExApp.Range[sLR,sTD].Borders[_cTBorder].Weight := wLW;
ExApp.Range[sLR,sTD].Borders[_cTBorder].ColorIndex:= 1;
end;
if (wBorder and 8 = then begin
ExApp.Range[sLR,sTD].Borders[_cBBorder].LineStyle := _cLWContinuous;
ExApp.Range[sLR,sTD].Borders[_cBBorder].Weight := wLW;
ExApp.Range[sLR,sTD].Borders[_cBBorder].ColorIndex:= 1;
end;
if (wBorder and 16 = 16) then begin
ExApp.Range[sLR,sTD].Borders[_cInsideV].LineStyle := _cLWContinuous;
ExApp.Range[sLR,sTD].Borders[_cInsideV].Weight := wLW;
ExApp.Range[sLR,sTD].Borders[_cInsideV].ColorIndex:= 1;
end;
if (wBorder and 32 = 32) then begin
ExApp.Range[sLR,sTD].Borders[_cInsideH].LineStyle := _cLWContinuous;
ExApp.Range[sLR,sTD].Borders[_cInsideH].Weight := wLW;
ExApp.Range[sLR,sTD].Borders[_cInsideH].ColorIndex:= 1;
end;
Except
Exit;
end;
Result := True;
End;

Function TExporter.FormatArea(Arg1,Arg2 : string; Align : Char): Boolean;
var _Align : LongInt;
Begin
Result := False;
if VarIsNull(ExApp) or VarIsNull(WBook) then
Exit;
Try
case Align of
'c','C': _Align := stAlignCenter;
'l','L': _Align := stAlignLeft;
'r','R': _Align := stAlignRight;
else _Align := stAlignFill;
end;
ExApp.Range[Arg1,Arg2].HorizontalAlignment := _Align;
ExApp.Range[Arg1,Arg2].Merge;
Except
Exit;
end;
Result := True;
End;

Function TExporter.InsertRange(Area : string; _Shift_ : Char): Boolean;
var _Shift : LongInt;
Begin
Result := False;
if VarIsNull(ExApp) or VarIsNull(WBook) then
Exit;
Try
case _Shift_ of
'd','D': _Shift := _cShiftDown;
'r','R': _Shift := _cShiftRight;
else _Shift := _cShiftRight;
end;
ExApp.Range[Area].Insert(Shift := _Shift);
Except
Exit;
end;
Result := True;
End;

Function TExporter.ShrinkCells(RawU, ColL, RawD, ColR : word) : Boolean;
Begin
Result := False;
if ((RawU<=0) or (ColL<=0) or (RawD<=0) or (ColR<=0)) then
Exit;
if VarIsNull(ExApp) or VarIsNull(WBook) then
Exit;
Try
ExApp.Range[Digit2Char(ColL)+Long2Str(RawU),Digit2Char(ColR)+Long2Str(RawD)].ShrinkToFit := True;
//ExApp.Range[Digit2Char(ColL)+Long2Str(RawU),Digit2Char(ColR)+Long2Str(RawD)].Set_ShrinkToFit;
Except
Exit;
end;
Result := True;
End;

Function TExporter.AlignCells(RawU, ColL, RawD, ColR : word; Align : Char) : Boolean;
var _Align : LongInt;
Begin
Result := False;
if ((RawU<=0) or (ColL<=0) or (RawD<=0) or (ColR<=0)) then
Exit;
if VarIsNull(ExApp) or VarIsNull(WBook) then
Exit;
Try
case Align of
'c','C': _Align := stAlignCenter;
'l','L': _Align := stAlignLeft;
'r','R': _Align := stAlignRight;
else _Align := stAlignFill;
end;
ExApp.Range[Digit2Char(ColL)+Long2Str(RawU),Digit2Char(ColR)+Long2Str(RawD)].HorizontalAlignment := _Align;
Except
Exit;
end;
Result := True;
End;

Function TExporter.MergeCells(RawU, ColL, RawD, ColR : word) : Boolean;
Begin
Result := False;
if ((RawU<=0) or (ColL<=0) or (RawD<=0) or (ColR<=0)) then
Exit;
if VarIsNull(ExApp) or VarIsNull(WBook) then
Exit;
Try
ExApp.Range[Digit2Char(ColL)+Long2Str(RawU),Digit2Char(ColR)+Long2Str(RawD)].Merge;
//ExApp.Range[Digit2Char(ColL)+Long2Str(RawU),Digit2Char(ColR)+Long2Str(RawD)].Set_MergeCells(1);
Except
Exit;
end;
Result := True;
End;

Function TExporter.FormatCells(RawU, ColL, RawD, ColR : word; Align : Char): Boolean;
var _Align : LongInt;
ir, jc,
ix, jy : word;
CStart,
CEnd : word;
StopF : Boolean;
Begin
Result := False;
if ((RawU<=0) or (ColL<=0) or (RawD<=0) or (ColR<=0)) then
Exit;
if VarIsNull(ExApp) or VarIsNull(WBook) then
Exit;
Try
//ExApp.Range[Digit2Char(ColL)+Long2Str(RawU),Digit2Char(ColR)+Long2Str(RawD)].Select;
FOR ir := RawU TO RawD DO BEGIN
jc := ColL;
while jc <= ColR do
begin
CStart := jc;
// Finding Empty Cell
Inc(jc);
StopF := VarToStr(ExApp.Cells[ir,jc].Value) = '';
while StopF and (jc < ColR) do
begin
Inc(jc);
StopF := VarToStr(ExApp.Cells[ir,jc].Value) = '';
end;
//find Next Fulled Cell
if not StopF then // she's in the formatted area
CEnd := jc - 1 // end of formated Area
else CEnd := ColR;
FormatArea(Digit2Char(CStart)+Long2Str(ir),Digit2Char(CEnd)+Long2Str(ir), Align); // Format
end;
END;
Except
Exit;
end;
Result := True;
End;

Function TExporter.Digit2Char(Position : longint):String;
Const Eng = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
var Kern, Postf, tmpPos : longint;
Res : String;
Begin
Res := '';
if (Position <= 0) then
begin
Digit2Char := '';
Exit;
end;

tmpPos := Position;
PostF := tmpPos mod 26;
Kern := tmpPos div 26;

repeat
if (PostF = 0) then
begin
dec(Kern);
PostF := 26;
end;
Res := Copy(Eng,PostF,1) + Res;

tmpPos := Kern;
PostF := tmpPos mod 26;
Kern := tmpPos div 26;
until (tmpPos = 0);
Digit2Char := Res;
End;

Function TExporter.SetCellValue;
//var _cell : string;
Begin
Result := False;
if ((Raw<=0) or (Col<=0)) then
Exit;
if VarIsNull(ExApp) or VarIsNull(WBook) then
Exit;
Try
ExApp.Cells[Raw, Col].Font.Color := Color;
// _cell := Digit2Char(Col)+Long2Str(Raw);
ExApp.Cells[Raw, Col].Font.Size := FontSize;
ExApp.Cells[Raw, Col] := Value;
ExApp.Cells[Raw, Col].Font.Bold := FontStyle and 1 = 1;
ExApp.Cells[Raw, Col].Font.Italic := FontStyle and 2 = 2;
ExApp.Cells[Raw, Col].Font.Underline := FontStyle and 4 = 4;
Except
Exit;
end;
Result := True;
End;

Function TExporter.SetCellFormula(Raw, Col : word; Formula : String;
Color : Longint; FontStyle: Byte): Boolean;
var _cell : string;
Begin
Result := False;
if ((Raw<=0) or (Col<=0)) then
Exit;
if VarIsNull(ExApp) or VarIsNull(WBook) then
Exit;
Try
ExApp.Cells[Raw, Col].Font.Color := Color;
ExApp.Cells[Raw, Col].Font.Size := FontSize;
ExApp.Cells[Raw, Col].FormulaLocal := Formula;
ExApp.Cells[Raw, Col].Font.Bold := FontStyle and 1 = 1;
ExApp.Cells[Raw, Col].Font.Italic := FontStyle and 2 = 2;
ExApp.Cells[Raw, Col].Font.Underline := FontStyle and 4 = 4;
Except
Exit;
end;
Result := True;
End;

{=========================== External declarations =========================}
Function CreateOleO(FileName : String; Visible : Boolean) : Boolean;
Begin
ExcelApp := TExporter.Create(FileName, Visible);
Result := Assigned(ExcelApp);
End;

Function SetCellS;
Begin
if Assigned(ExcelApp) then
Result := ExcelApp.SetCellValue(Raw, Col, Value, Color, FontStyle)
else Result := False;
End;

Function SetCellF;
Begin
if Assigned(ExcelApp) then
Result := ExcelApp.SetCellValue(Raw, Col, Value, Color, FontStyle)
else Result := False;
End;

Function SetCellL;
Begin
if Assigned(ExcelApp) then
Result := ExcelApp.SetCellValue(Raw, Col, Value, Color, FontStyle)
else Result := False;
End;

Function SetCellFm;
Begin
if Assigned(ExcelApp) then
Result := ExcelApp.SetCellFormula(Raw, Col, Formula, Color, FontStyle)
else Result := False;
End;

Function SetFontS (Size : Word) : Boolean;
Begin
if Assigned(ExcelApp) then
Result := ExcelApp.SetFontSize(Size)
else Result := False;
End;

Function FormatArea(Arg1,Arg2 : string; Align : Char) : Boolean;
Begin
if Assigned(ExcelApp) then
Result := ExcelApp.FormatArea(Arg1,Arg2,Align)
else Result := False;
End;

Function InsertRange(Area : string; Shift : Char) : Boolean;
Begin
if Assigned(ExcelApp) then
Result := ExcelApp.InsertRange(Area, Shift)
else Result := False;
End;

Function SetCellSize(Size : word ; Raw, Col : word ; Direct : Char) : Boolean;
Begin
if Assigned(ExcelApp) then
Result := ExcelApp.SetCellSize(Size, Raw, Col, Direct)
else Result := False;
End;

Function FrameCells;
Begin
if Assigned(ExcelApp) then
Result := ExcelApp.FrameCells(RawU, ColL, RawD, ColR, wBorder, wLineWeight)
else Result := False;
End;

Function ShrinkCells(RawU, ColL, RawD, ColR : word) : Boolean;
Begin
if Assigned(ExcelApp) then
Result := ExcelApp.ShrinkCells(RawU, ColL, RawD, ColR)
else Result := False;
End;

Function AlignCells(RawU, ColL, RawD, ColR : word; Align : Char) : Boolean;
Begin
if Assigned(ExcelApp) then
Result := ExcelApp.AlignCells(RawU, ColL, RawD, ColR, Align)
else Result := False;
End;

Function MergeCells(RawU, ColL, RawD, ColR : word) : Boolean;
Begin
if Assigned(ExcelApp) then
Result := ExcelApp.MergeCells(RawU, ColL, RawD, ColR)
else Result := False;
End;

Function FormatCells(RawU, ColL, RawD, ColR : word; Align : Char) : Boolean;
Begin
if Assigned(ExcelApp) then
Result := ExcelApp.FormatCells(RawU, ColL, RawD, ColR, Align)
else Result := False;
End;

Function KillOle : Boolean;
Begin
Result := True;
if Assigned(ExcelApp) then
ExcelApp.Destroy
else Result := False;
End;
//----------------------------------------------------------------------
BEGIN
RegisterFunction('CreateOleO',@CreateOleO,ftBoolean,Chr(ftString)+Chr(ftBoolean));

RegisterFunction('SetCellS' ,@SetCellS ,ftBoolean,Chr(ftWord)+Chr(ftWord)+
Chr(ftString) +Chr(ftLongInt)+Chr(ftByte));

RegisterFunction('SetCellF' ,@SetCellF ,ftBoolean,Chr(ftWord)+Chr(ftWord)+
Chr(ftDouble) +Chr(ftLongInt)+Chr(ftByte));

RegisterFunction('SetCellL' ,@SetCellL ,ftBoolean,Chr(ftWord)+Chr(ftWord)+
Chr(ftLongInt)+Chr(ftLongInt)+Chr(ftByte));

RegisterFunction('SetCellFm' ,@SetCellFm ,ftBoolean,Chr(ftWord)+Chr(ftWord)+
Chr(ftString) +Chr(ftLongInt)+Chr(ftByte));

RegisterFunction('SetFontS' ,@SetFontS ,ftBoolean,Chr(ftWord));

RegisterFunction('FormatArea',@FormatArea,ftBoolean,Chr(ftString)+Chr(ftString)+
Chr(ftChar));

RegisterFunction('SetCellSize',@SetCellSize,ftBoolean,Chr(ftWord)+Chr(ftWord)+Chr(ftWord)+
Chr(ftChar));

RegisterFunction('InsertRange',@InsertRange,ftBoolean,Chr(ftString)+Chr(ftChar));

RegisterFunction('ShrinkCells',@ShrinkCells,ftBoolean,Chr(ftWord)+Chr(ftWord)+
Chr(ftWord)+Chr(ftWord));

RegisterFunction('AlignCells',@AlignCells,ftBoolean,Chr(ftWord)+Chr(ftWord)+
Chr(ftWord)+Chr(ftWord)+Chr(ftChar));

RegisterFunction('MergeCells',@MergeCells,ftBoolean,Chr(ftWord)+Chr(ftWord)+
Chr(ftWord)+Chr(ftWord));

RegisterFunction('FormatCells',@FormatCells,ftBoolean,Chr(ftWord)+Chr(ftWord)+
Chr(ftWord)+Chr(ftWord)+Chr(ftChar));

RegisterFunction('FrameCells',@FrameCells,ftBoolean,Chr(ftWord)+Chr(ftWord)+
Chr(ftWord)+Chr(ftWord)+Chr(ftWord)+Chr(ftWord));

RegisterFunction('KillOle' ,@KillOLE ,ftBoolean,'');
END.

[Nuts]

//=========================================================================
// Процедура печати в формате Excel прямая запись в xls-файл
//=========================================================================
// Печать шапки отчета
procedure PrintHeader(var aStr : LongInt);
{
xlSetCellStringValue('Исполнение договоров (финансовая часть)', 1, 1, 1, 1);

xlSetCellStringValue('Договор', 2, 1, 2, 1);
xlSetCellStringValue('Соглашение', 2, 3, 2, 3);
xlSetCellStringValue('Относится к', 2, 5, 2, 5);
xlSetCellStringValue('Контрагент', 2, 7, 2, 7);
xlSetCellStringValue('Срок действия', 2, 8, 2, ;
xlSetCellStringValue('Вид', 2, 10, 2, 10);
xlSetCellStringValue('Назначение', 2, 11, 2, 11);
xlSetCellStringValue('Тип по', 2, 12, 2, 12);
xlSetCellStringValue('вал.', 3, 12, 3, 12);
xlSetCellStringValue('Вал.', 2, 13, 2, 13);
xlSetCellStringValue('Статус', 2, 14, 2, 14);
xlSetCellStringValue('Наши платежи', 2, 15, 2, 15);
xlSetCellStringValue('Платежи контрагента', 2, 21, 2, 21);

xlSetCellStringValue('Номер', 3, 1, 3, 1);
xlSetCellStringValue('Дата', 3, 2, 3, 2);
xlSetCellStringValue('Номер', 3, 3, 3, 3);
xlSetCellStringValue('Дата', 3, 4, 3, 4);
xlSetCellStringValue('Номер', 3, 5, 3, 5);
xlSetCellStringValue('Дата', 3, 6, 3, 6);
xlSetCellStringValue('С', 3, 8, 3, ;
xlSetCellStringValue('По', 3, 9, 3, 9);

xlSetCellStringValue('План', 3, 15, 3, 15);
xlSetCellStringValue('Факт', 3, 17, 3, 17);
xlSetCellStringValue('Откл', 3, 19, 3, 19);
xlSetCellStringValue('План', 3, 21, 3, 21);
xlSetCellStringValue('Факт', 3, 23, 3, 23);
xlSetCellStringValue('Откл', 3, 25, 3, 25);

xlSetCellStringValue('В НДЕ', 4, 15, 4, 15);
xlSetCellStringValue('В валюте', 4, 16, 4, 16);
xlSetCellStringValue('В НДЕ', 4, 17, 4, 17);
xlSetCellStringValue('В валюте', 4, 18, 4, 18);
xlSetCellStringValue('В НДЕ', 4, 19, 4, 19);
xlSetCellStringValue('В валюте', 4, 20, 4, 20);
xlSetCellStringValue('В НДЕ', 4, 21, 4, 21);
xlSetCellStringValue('В валюте', 4, 22, 4, 22);
xlSetCellStringValue('В НДЕ', 4, 23, 4, 23);
xlSetCellStringValue('В валюте', 4, 24, 4, 24);
xlSetCellStringValue('В НДЕ', 4, 25, 4, 25);
xlSetCellStringValue('В валюте', 4, 26, 4, 26);

aStr := 4;
}

#include NextTree.vpp // функции для отчетов

procedure PrintInExcelXls(aRepType : Byte);
var
StrCount, ColCount, HeaderStrCount : LongInt;
XlRes : Boolean;
aFileName : String;
i, j : Integer;
{
StartNewVisual( vtNumericVisual, vfTimer+vfBreak+vfConfirm, ''#3'Подготовка отчета к печати', 1);
XlRes := True;
aFileName := GetStringParameter('Files','OutputFilesDirectory',0) + 'ispfin.xls';
DeleteFile(aFileName);
XlRes := xlCreateExcel((aFileName), True);
if (XlRes)
XlRes := xlIsExcelValid;
if (not XlRes)
{
StopVisual('',0);
Exit;
}

PrintHeader(HeaderStrCount); // Печать шапки отчета
StrCount := HeaderStrCount + 1;
TreePushPos(MainTree);

// Ctrl-P - печать всего отчета
if (aRepType = 1)
TreeGetFirstEx(MainTree);
// Alt-P - печать c текущего уровня
else
if (IsValid(#Dogovor))
while (Dogovor.cDogovor <> Comp(0)) do
TreeGetPrevEx(MainTree);

FirstLevel := TreeLevel(MainTree);

do
{
if (not NextVisual)
{
StopVisual('',0);
Message('Формирование отчета прервано пользователем.',OKButton)
xlKillExcel;
TreePopPos(MainTree);
RescanPanel(#TempDescr);
Exit;
}

if (not IsValid(#Dogovor))
{
if (not fTreeNext(aRepType)) Break;
Continue;
}

// Договор
if (Dogovor.cDogovor = Comp(0))
ColCount := 1
// Соглашение
else
ColCount := 3;

xlSetCellStringValue('N ' + Dogovor.NoDoc, StrCount, ColCount, StrCount, ColCount);
ColCount := ColCount + 1;
if (LongInt(Dogovor.DDoc) <> 0)
xlSetCellStringValue(DateToStr(Dogovor.DDoc,'MM/DD/YYYY'), StrCount, ColCount, StrCount, ColCount);

// Вышележащий документ
if (Dogovor.cDogovor <> Comp(0))
{
ColCount := 5;
xlSetCellStringValue('N ' + DogovorUp.NoDoc, StrCount, ColCount, StrCount, ColCount);
ColCount := ColCount + 1;
if (LongInt(DogovorUp.DDoc) <> 0)
xlSetCellStringValue(DateToStr(DogovorUp.DDoc,'MM/DD/YYYY'), StrCount, ColCount, StrCount, ColCount);
}

// Реквизиты
ColCount := 7;
xlSetCellStringValue(KatOrg1Name, StrCount, ColCount, StrCount, ColCount);
ColCount := ColCount + 1;
if (LongInt(Dogovor.DBeg) <> 0)
xlSetCellStringValue(DateToStr(Dogovor.DBeg,'MM/DD/YYYY'), StrCount, ColCount, StrCount, ColCount);
ColCount := ColCount + 1;
if (LongInt(Dogovor.DEnd) <> 0)
xlSetCellStringValue(DateToStr(Dogovor.DEnd,'MM/DD/YYYY'), StrCount, ColCount, StrCount, ColCount);
ColCount := ColCount + 1;
xlSetCellStringValue(KatVidDName, StrCount, ColCount, StrCount, ColCount);
ColCount := ColCount + 1;
xlSetCellStringValue(KatNaznaName, StrCount, ColCount, StrCount, ColCount);
ColCount := ColCount + 1;
xlSetCellStringValue(fTip, StrCount, ColCount, StrCount, ColCount);
ColCount := ColCount + 1;
xlSetCellStringValue(fValOtch, StrCount, ColCount, StrCount, ColCount);
ColCount := ColCount + 1;
xlSetCellStringValue(DogovorStatus, StrCount, ColCount, StrCount, ColCount);

// Суммы
ColCount := ColCount + 1;
xlSetCellNumberValue(TempDescr.Sum[7], StrCount, ColCount, StrCount, ColCount);
ColCount := ColCount + 1;
xlSetCellNumberValue(TempDescr.Sum[8], StrCount, ColCount, StrCount, ColCount);
ColCount := ColCount + 1;
xlSetCellNumberValue(TempDescr.Sum[9], StrCount, ColCount, StrCount, ColCount);
ColCount := ColCount + 1;
xlSetCellNumberValue(TempDescr.Sum[10], StrCount, ColCount, StrCount, ColCount);
ColCount := ColCount + 1;
xlSetCellNumberValue(TempDescr.Sum[11], StrCount, ColCount, StrCount, ColCount);
ColCount := ColCount + 1;
xlSetCellNumberValue(TempDescr.Sum[12], StrCount, ColCount, StrCount, ColCount);
ColCount := ColCount + 1;
xlSetCellNumberValue(TempDescr.Sum[1], StrCount, ColCount, StrCount, ColCount);
ColCount := ColCount + 1;
xlSetCellNumberValue(TempDescr.Sum[2], StrCount, ColCount, StrCount, ColCount);
ColCount := ColCount + 1;
xlSetCellNumberValue(TempDescr.Sum[3], StrCount, ColCount, StrCount, ColCount);
ColCount := ColCount + 1;
xlSetCellNumberValue(TempDescr.Sum[4], StrCount, ColCount, StrCount, ColCount);
ColCount := ColCount + 1;
xlSetCellNumberValue(TempDescr.Sum[5], StrCount, ColCount, StrCount, ColCount);
ColCount := ColCount + 1;
xlSetCellNumberValue(TempDescr.Sum[6], StrCount, ColCount, StrCount, ColCount);

StrCount := StrCount + 1;

if (not fTreeNext(aRepType)) Break;

}
while True;

StopVisual('',0);

// Настройка форматов ячеек
StartNewVisual( vtRotateVisual, vfTimer+vfConfirm, ''#3'Настройка формата Excel-файла', 1);
xlSetNumberFormat('ДД/ММ/ГГГГ', HeaderStrCount + 1, 2, StrCount, 2);
xlSetNumberFormat('ДД/ММ/ГГГГ', HeaderStrCount + 1, 4, StrCount, 4);
xlSetNumberFormat('ДД/ММ/ГГГГ', HeaderStrCount + 1, 6, StrCount, 6);
xlSetNumberFormat('ДД/ММ/ГГГГ', HeaderStrCount + 1, 8, StrCount, 9);
xlSetNumberFormat('### ### ### ### ##0,00', HeaderStrCount + 1, 15, StrCount, 26);

xlSetColumnWidth(17, 1, 1, StrCount, 1); // Номер договора
xlSetColumnWidth(17, 1, 3, StrCount, 3); // Номер соглашения
xlSetColumnWidth(17, 1, 5, StrCount, 5); // Номер вышележащего
xlSetColumnWidth(20, 1, 7, StrCount, 7); // Контрагент
xlSetColumnWidth(14, 1, 10, StrCount, 10); // Вид
xlSetColumnWidth(14, 1, 11, StrCount, 11); // Назначение
xlSetColumnWidth(5, 1, 13, StrCount, 13); // Валюта

xlSetColumnWidth(18, 1, 15, StrCount, 26); // Суммы

xlSetFontStyle(xlBold, 1, 1, HeaderStrCount, 26);
xlSetFontSize(16, 1, 1, 1, 26);
xlSetFontSize(12, 2, 1, HeaderStrCount, 26);

StrCount := StrCount - 1;
xlFrameCells(xlBorderL or xlBorderR or xlBorderT or xlBorderB or xlInsideV or xlInsideH, xlThin, 0, 0,
HeaderStrCount + 1,1,StrCount,26);

xlFrameCells(xlBorderL or xlBorderR or xlBorderT or xlBorderB, xlMedium, 0, 0, 1, 1, 1,26);

xlFrameCells(xlBorderL or xlBorderR or xlBorderT or xlBorderB, xlMedium, 0, 0, 2, 1, 2, 2);
xlFrameCells(xlBorderL or xlBorderR or xlBorderT or xlBorderB, xlMedium, 0, 0, 2, 3, 2, 4);
xlFrameCells(xlBorderL or xlBorderR or xlBorderT or xlBorderB, xlMedium, 0, 0, 2, 5, 2, 6);
xlFrameCells(xlBorderL or xlBorderR or xlBorderT or xlBorderB, xlMedium, 0, 0, 2, 7, 4, 7);
xlFrameCells(xlBorderL or xlBorderR or xlBorderT or xlBorderB, xlMedium, 0, 0, 2, 8, 2, 9);
for (i := 10; i <= 14; i := i + 1)
xlFrameCells(xlBorderL or xlBorderR or xlBorderT or xlBorderB, xlMedium, 0, 0, 2, i, 4, i);

xlFrameCells(xlBorderL or xlBorderR or xlBorderT or xlBorderB, xlMedium, 0, 0, 2, 15, 2, 20);
xlFrameCells(xlBorderL or xlBorderR or xlBorderT or xlBorderB, xlMedium, 0, 0, 2, 21, 2, 26);

for (i := 1; i <= 6; i := i + 1)
xlFrameCells(xlBorderL or xlBorderR or xlBorderT or xlBorderB, xlMedium, 0, 0, 3, i, 4, i);
xlFrameCells(xlBorderL or xlBorderR or xlBorderT or xlBorderB, xlMedium, 0, 0, 3, 8, 4, ;
xlFrameCells(xlBorderL or xlBorderR or xlBorderT or xlBorderB, xlMedium, 0, 0, 3, 9, 4, 9);

xlFrameCells(xlBorderL or xlBorderR or xlBorderT or xlBorderB, xlMedium, 0, 0, 3, 15, 3, 16);
xlFrameCells(xlBorderL or xlBorderR or xlBorderT or xlBorderB, xlMedium, 0, 0, 3, 17, 3, 18);
xlFrameCells(xlBorderL or xlBorderR or xlBorderT or xlBorderB, xlMedium, 0, 0, 3, 19, 3, 20);
xlFrameCells(xlBorderL or xlBorderR or xlBorderT or xlBorderB, xlMedium, 0, 0, 3, 21, 3, 22);
xlFrameCells(xlBorderL or xlBorderR or xlBorderT or xlBorderB, xlMedium, 0, 0, 3, 23, 3, 24);
xlFrameCells(xlBorderL or xlBorderR or xlBorderT or xlBorderB, xlMedium, 0, 0, 3, 25, 3, 26);
for (i := 15; i <= 26; i := i + 1)
xlFrameCells(xlBorderL or xlBorderR or xlBorderT or xlBorderB, xlMedium, 0, 0, 4, i, 4, i);

xlFrameCells(xlBorderL or xlBorderR or xlBorderT or xlBorderB, xlMedium, 0, 0, HeaderStrCount + 1, 1,StrCount, 2);
xlFrameCells(xlBorderL or xlBorderR or xlBorderT or xlBorderB, xlMedium, 0, 0, HeaderStrCount + 1, 3,StrCount, 4);
xlFrameCells(xlBorderL or xlBorderR or xlBorderT or xlBorderB, xlMedium, 0, 0, HeaderStrCount + 1, 5,StrCount, 6);
xlFrameCells(xlBorderL or xlBorderR or xlBorderT or xlBorderB, xlMedium, 0, 0, HeaderStrCount + 1, 7,StrCount,14);
xlFrameCells(xlBorderL or xlBorderR or xlBorderT or xlBorderB, xlMedium, 0, 0, HeaderStrCount + 1,15,StrCount,17);

xlFrameCells(xlBorderL or xlBorderR or xlBorderT or xlBorderB, xlMedium, 0, 0, HeaderStrCount + 1,15,StrCount,16);
xlFrameCells(xlBorderL or xlBorderR or xlBorderT or xlBorderB, xlMedium, 0, 0, HeaderStrCount + 1,17,StrCount,18);
xlFrameCells(xlBorderL or xlBorderR or xlBorderT or xlBorderB, xlMedium, 0, 0, HeaderStrCount + 1,19,StrCount,20);
xlFrameCells(xlBorderL or xlBorderR or xlBorderT or xlBorderB, xlMedium, 0, 0, HeaderStrCount + 1,21,StrCount,22);
xlFrameCells(xlBorderL or xlBorderR or xlBorderT or xlBorderB, xlMedium, 0, 0, HeaderStrCount + 1,23,StrCount,24);
xlFrameCells(xlBorderL or xlBorderR or xlBorderT or xlBorderB, xlMedium, 0, 0, HeaderStrCount + 1,25,StrCount,26);

StopVisual('',0);

xlKillExcel;
TreePopPos(MainTree);
RescanPanel(#TempDescr);
}

//=========================================================================
// Процедура печати в текстовом формате
//=========================================================================
// Печать сумм как для ветки, так и для договора и соглашения
procedure PrintSumms;
{
fIspFin.Write(TempDescr.Sum[7]);
fIspFin.Write(TempDescr.Sum[8]);
fIspFin.Write(TempDescr.Sum[9]);
fIspFin.Write(TempDescr.Sum[10]);
fIspFin.Write(TempDescr.Sum[11]);
fIspFin.Write(TempDescr.Sum[12]);
fIspFin.Write(TempDescr.Sum[1]);
fIspFin.Write(TempDescr.Sum[2]);
fIspFin.Write(TempDescr.Sum[3]);
fIspFin.Write(TempDescr.Sum[4]);
fIspFin.Write(TempDescr.Sum[5]);
fIspFin.Write(TempDescr.Sum[6]);
fIspFin.Write(TempDescr.Sum[13]);
fIspFin.Write(TempDescr.Sum[14]);
}

procedure PrintInText(aRepType : Byte);
var
sFilter, sVal, sVal1, Str : String;
{
StartNewVisual( vtNumericVisual, vfTimer+vfBreak+vfConfirm, ''#3'Подготовка отчета к печати', 1);

TreePushPos(MainTree);

// Печать всего отчета
if (aRepType = 1)
TreeGetFirstEx(MainTree);
// Печать c текущего уровня
else
if (IsValid(#Dogovor))
while (Dogovor.cDogovor <> Comp(0)) do
TreeGetPrevEx(MainTree);

FirstLevel := TreeLevel(MainTree);

// Заголовок
if ((UserDeskRep.ResWord[3] and 1) = 1)
{
Str := '';
if (LongInt(UserDeskRep.ResDate[1]) <> 0)
{
fIspFin.Write(UserDeskRep.ResDate[1]);
Str := 'с ' + String(UserDeskRep.ResDate[1]) + ' ';
}
else fIspFin.Write(' ');
if (LongInt(UserDeskRep.ResDate[2]) <> 0)
{
fIspFin.Write(UserDeskRep.ResDate[2]);
Str := Str + 'по ' + String(UserDeskRep.ResDate[2]);
}
else fIspFin.Write(' ');

if (Str <> '')
{
fIspFin.PutEventByID(feTrue, fcExistPeriodFin);
fIspFin.Write(Str);
}
}
else
fIspFin.SkipFormat(2);

sFilter := '';
if ((UserDeskRep.ResWord[3] and 2) > 1) sFilter := sFilter + '<Назначение>';
if ((UserDeskRep.ResWord[3] and 4) > 1) sFilter := sFilter + '<Контрагент>';
if ((UserDeskRep.ResWord[3] and > 1) sFilter := sFilter + '<Вид договора>';
if ((UserDeskRep.ResWord[3] and 16) > 1) sFilter := sFilter + '<Только с отклонениями>';
if (sFilter <> '')
{
fIspFin.PutEventByID(feTrue, fcExistFilterFin);
fIspFin.Write(sFilter);
}

sVal1 := if (IsValid(#KlVal3), KlVal3.SimvolV + ' ( ' + KlVal3.Dollar + ' )',
s_SimvRub + ' ( ' + sGetTune('NDE.NameRubl') + ' )' );
if (UserDeskRep.ResWord[1] = 0)
sVal := 'Валюта документа'
else
sVal := sVal1;
fIspFin.Write(sVal);
fIspFin.Write(sVal1);

do
{
if (not NextVisual)
{
StopVisual('',0);
Message('Формирование отчета прервано пользователем.',OKButton)
TreePopPos(MainTree);
RescanPanel(#TempDescr);
Exit;
}

// Ветка
if (not IsValid(#Dogovor))
{
fIspFin.PutEventById(feDoLoop,fcGruppaFin);
fIspFin.Write(PrintSpace(TreeLevel(MainTree)) + TempDescr.Name);
PrintSumms; // Печать сумм
fIspFin.PutEventById(feBreak,fcGruppaFin);

if (not fTreeNext(aRepType)) Break;
Continue;
}

fIspFin.PutEventById(feDoLoop,fcMainRecFin);
// Договор
if (Dogovor.cDogovor = Comp(0))
{
fIspFin.Write(Dogovor.NRec);
fIspFin.Write(Dogovor.NoDoc);
if (LongInt(Dogovor.DDoc) <> 0) fIspFin.Write(Dogovor.DDoc)
else fIspFin.Write(' ');
fIspFin.SkipFormat(3);
}
// Соглашение
else
{
fIspFin.SkipFormat(3);
fIspFin.Write(Dogovor.NRec);
fIspFin.Write(Dogovor.NoDoc);
if (LongInt(Dogovor.DDoc) <> 0) fIspFin.Write(Dogovor.DDoc)
else fIspFin.Write(' ');
}

// Вышележащий документ
if (Dogovor.cDogovor <> Comp(0))
{
fIspFin.Write(DogovorUp.NRec);
fIspFin.Write(DogovorUp.NoDoc);
if (LongInt(DogovorUp.DDoc) <> 0) fIspFin.Write(DogovorUp.DDoc)
else fIspFin.Write(' ');
}
else
fIspFin.SkipFormat(3);

// Реквизиты
fIspFin.Write(KatOrg1Name);
if (LongInt(Dogovor.DBeg) <> 0) fIspFin.Write(Dogovor.DBeg)
else fIspFin.Write(' ');
if (LongInt(Dogovor.DEnd) <> 0) fIspFin.Write(Dogovor.DEnd)
else fIspFin.Write(' ');
fIspFin.Write(KatVidDName);
fIspFin.Write(KatNaznaName);
fIspFin.Write(fTip);
fIspFin.Write(fValOtch);
fIspFin.Write(DogovorStatus);
PrintSumms; // Печать сумм

// Наши платежи
_loop Rasx
{
fIspFin.PutEventById(feDoLoop, fcOtgr1Fin);
fIspFin.Write(Substr(Rasx.NoDocRt,1,10));
if (LongInt(Rasx.dDoc) <> 0) fIspFin.Write(Rasx.dDoc)
else fIspFin.Write(' ');
fIspFin.Write(fValRasx);
fIspFin.Write(Rasx.NoDocPr);
fIspFin.Write(Rasx.Kol);
fIspFin.Write(Rasx.Summa);
fIspFin.Write(Rasx.cDouble1);
fIspFin.Write(Rasx.cDouble2);
fIspFin.Write(Rasx.cDouble1 - Rasx.Kol);
fIspFin.Write(Rasx.cDouble2 - Rasx.Summa);
}

// Платежи контрагента
_loop Prix
{
fIspFin.PutEventById(feDoLoop, fcOtgr2Fin);
fIspFin.Write(Substr(Prix.NoDocRt,1,10));
if (LongInt(Prix.dDoc) <> 0) fIspFin.Write(Prix.dDoc)
else fIspFin.Write(' ');
fIspFin.Write(fValPrix);
fIspFin.Write(Prix.NoDocPr);
fIspFin.Write(Prix.Kol);
fIspFin.Write(Prix.Summa);
fIspFin.Write(Prix.cDouble1);
fIspFin.Write(Prix.cDouble2);
fIspFin.Write(Prix.cDouble1 - Prix.Kol);
fIspFin.Write(Prix.cDouble2 - Prix.Summa);
}

fIspFin.PutEventById(feBreak,fcMainRecFin);

if (not fTreeNext(aRepType)) Break;

}
while True;

StopVisual('',0);

if (not fIspFin.Error)
fIspFin.ShowFile('Исполнение договоров (финансовая часть)')
else
{
fIspFin.AbortForm;
Message(''#3'В форме возникли ошибки.'#13#3+'Просмотр невозможен');
}

TreePopPos(MainTree);
RescanPanel(#TempDescr);
}

[GTHack]

сильно не бейте - но я всё равно спрошу -
куда это всё пихать чем компилировать, что для этого нужно и как использовать?

или чтоб много не писать - маленький пример

P.s.
первый текс я запихал в exel.vip
и випом откомпилировать пытался и получил

unit exelexp;
^
Ожидался тип объекта

[GTHack]

сильно не бейте - но я всё равно спрошу -
куда это всё пихать чем компилировать, что для этого нужно и как использовать?

или чтоб много не писать - маленький пример

P.s.
первый текс я запихал в exel.vip
и випом откомпилировать пытался и получил

unit exelexp;
^
Ожидался тип объекта

[Nuts]

Это паскалевские файлы - их не нужно компилить - они в Галактике уже есть
Кинул сюда первый пример - чтобы вы смогли сами посмотреть параметры вызова функций и их алгоритм.
см описание
Function SetCellSize(Size : word ; Raw, Col : word ; Direct : Char) : Boolean; Far;
// Объединение ячеек
Function MergeCells(RawU, ColL, RawD, ColR : word) : Boolean;
// Формат ячеек - объединение+центрирование+размер

Второй просто кусок кода использующий ex функции.