var
WB : TsWorkbook;
WS : TsWorksheet;
CmpnyNm : string;
RptTitle : string;
Row,i : integer;
Cell : PCell;
NoOfCol : integer;
SumOfCol : array of double;
ColHeader : array of string;
RptId : String;
Str : Tstringlist;
CoaCd : String;
FrCoaCd : String;
ToCoaCd : String;
TtlDb,TtlCr : double;
begin
try
WB := TsWorkbook.Create;
WS := WB.AddWorksheet(RptNm.Substring(0,30));
Row := 0;
GetCoaCd(RptNm,FrCoaCd,ToCoaCd);
GetRptIdCmpnyTtl(RptNm,RptId,CmpnyNm,RptTitle);
NoOfCol := 6;
ColHeader:= GetColHeader(RptId,NoOfCol);
SetLength(SumOfCol, NoOfCol);
for i:= 0 to NoOfCol-1 do SumOfCol[i] := 0;
WS.Options:= ws.Options - [soShowGridlines];
WriteCmpnyAndTitle(Ws,CmpnyNm,RptTitle,FrDt,ToDt,Row);
CoaCd := '';
TtlDb := 0;
TtlCr := 0;
DM.Q2.Close;
DM.Q2.SQL.Clear;
DM.Q2.SQL.Add('SELECT COUNT(*) ttl FROM ACCT.Func2 (0'+ ',''' + FrCoaCd + ''',''' + ToCoaCd + ''',''' + FrDt + ''',''' + ToDt + ''')' );
DM.Q2.Open;
P.Value := 0;
p.MaxValue := DM.Q2.FieldByName('ttl').AsInteger;
DM.Q2.Close;
DM.Q2.SQL.Clear;
DM.Q2.SQL.Add('SELECT COACD,AC,DT,FRMN,DSCP,DB,CR,BLNC FROM ACCT.Func2 (0' + ',''' + FrCoaCd + ''',''' + ToCoaCd + ''',''' + FrDt + ''',''' + ToDt + ''')' );
DM.Q2.Open;
txtLbl.Visible:=true;
while not(DM.Q2.EOF) do
begin
if CoaCd='' then
begin
CoaCd := DM.Q2.FieldByName('COACD').AsString;
TtlDb := TtlDb + DM.Q2.FieldByName('DB').AsFloat;
TtlCr := TtlCr + DM.Q2.FieldByName('CR').AsFloat;
WS.WriteText(Row,0,CoaCd);
ws.WriteFontStyle(Row, 0,[fssBold]);
ws.WriteFontColor(Row, 0,$00000080);
Row := Row+1;
WS.WriteText(Row,0,DM.Q2.FieldByName('AC').AsString);
ws.WriteFontStyle(Row, 0,[fssBold]);
ws.WriteFontColor(Row, 0,$00000080);
WriteHeader(WS,RptId,Row,ColHeader);
Row := Row+1;
WriteCellValue2(WS,2,Row,DM.Q2,false,SumOfCol);
Row := Row + 1;
end
else if DM.Q2.FieldByName('COACD').AsString <> CoaCd then
begin
for i:= 0 to 5 do
begin
Cell := ws.WriteBorders(Row,i,[cbNorth]);
WS.WriteBorderStyle(cell, cbNorth, lsThin, scBlack);
end;
WS.WriteNumber(Row,3,TtlDb,nfCustom,NumFormat);
WS.WriteNumber(Row,4,TtlCr,nfCustom,NumFormat);
ws.WriteFontStyle(Row, 3,[fssBold]);
ws.WriteFontStyle(Row, 4,[fssBold]);
CoaCd := DM.Q2.FieldByName('COACD').AsString;
TtlDb := 0;
TtlCr := 0;
Row := Row+1;
WS.WriteText(Row,0,CoaCd);
ws.WriteFontStyle(Row, 0,[fssBold]);
ws.WriteFontColor(Row, 0,$00000080);
Row := Row+1;
WS.WriteText(Row,0,DM.Q2.FieldByName('AC').AsString);
ws.WriteFontStyle(Row, 0,[fssBold]);
ws.WriteFontColor(Row, 0,$00000080);
WriteHeader(WS,RptId,Row,ColHeader);
Row := Row+1;
WriteCellValue2(WS,2,Row,DM.Q2,false,SumOfCol);
Row := Row + 1;
TtlDb := TtlDb + DM.Q2.FieldByName('DB').AsFloat;
TtlCr := TtlCr + DM.Q2.FieldByName('CR').AsFloat;
end
else
begin
WriteCellValue2(WS,2,Row,DM.Q2,false,SumOfCol);
Row := Row + 1;
TtlDb := TtlDb + DM.Q2.FieldByName('DB').AsFloat;
TtlCr := TtlCr + DM.Q2.FieldByName('CR').AsFloat;
end;
P.Value := P.Value+1;
txtLbl.Caption:= DM.Q2.FieldByName('AC').AsString;
application.ProcessMessages;
DM.Q2.Next
end;
for i:= 0 to 5 do
begin
Cell := ws.WriteBorders(Row,i,[cbNorth]);
WS.WriteBorderStyle(cell, cbNorth, lsThin, scBlack);
end;
WS.WriteNumber(Row,3,TtlDb,nfCustom,NumFormat);
WS.WriteNumber(Row,4,TtlCr,nfCustom,NumFormat);
ws.WriteFontStyle(Row, 3,[fssBold]);
ws.WriteFontStyle(Row, 4,[fssBold]);
WB.WriteToFile(RptNm + '.xlsx',true);
OpenDocument(RptNm + '.xlsx');
Result := 'OK';
except
on E: Exception do
begin
if E.Message.Contains('it is being used') then Result := 'Failed'
else Result := E.Message;
Str := TStringlist.create;
Str.Add(E.Message);
Str.SaveToFile(RptNm + '.err');
Str.Free;
end;
end;
WB.Free;
txtLbl.Visible:=false;
end;