полность рабочий код
| Код |
uses
ShellApi, ComObj, ExcelXP,
procedure TfmMain.actNaklsToExcelExecute(Sender: TObject);
Var
UsedRange, Range, Sheets:Variant;
iColForRekv, iColCount, iBegRow, iBegRowTitle, vRow:Integer;
s:String;
FirstAddress: string;
iColSum:Integer;
dDate:TDate;
begin
if not VarIsEmpty(NaklsToExcel) then begin
NaklsToExcel.Quit;
NaklsToExcel := Unassigned;
end;//if
with fmNakls do begin
try
Screen.Cursor:=crHourGlass;
tNakls.DisableControls;
tNaklsDet.DisableControls;
Try//открываем Excel и создаем раб.книгу
NaklsToExcel:=CreateOleObject('Excel.Application');
NaklsToExcel.SheetsInNewWorkbook:=1;
NaklsToExcel.WorkBooks.Add;
Sheets:=NaklsToExcel.Workbooks[1].Sheets[1];
Except
SysUtils.beep;
Screen.Cursor:=crDefault;
ShowMessage('Не могу открыть Excel!');
Exit;
end;//try-except
//Название заявки
tRekv.Open;
iBegRowTitle:=1;
//рисуем border
// Range:=Sheets.Range['A1'];
// Range.Borders[4].LineStyle := 1;
//название поставщика
// Sheets.Cells[iBegRowTitle,1]:=lcbApt.Text;
// Range:=Sheets.Cells[iBegRowTitle,1];
// Range.HorizontalAlignment := xlCenter;
// Range.VerticalAlignment := xlCenter;
// Inc(iBegRowTitle);
//подписывает под название поставщика
// Sheets.Cells[iBegRowTitle,1]:='/поставщик/';
// Range:=Sheets.Cells[iBegRowTitle,1];
// Range.HorizontalAlignment := xlCenter;
// Range.VerticalAlignment := xlCenter;
iColForRekv:=1;
if tRekvRNameUse.AsBoolean = true then begin
Inc(iBegRowTitle);
Sheets.Cells[iBegRowTitle,iColForRekv]:=tRekvRName.AsString;
end;
Sheets.Cells[iBegRowTitle,4]:='Сертификаты качества находятся';
Sheets.Cells[iBegRowTitle+1,4]:='по адресу: '+tRekvRAddress.AsString;
if tRekvRAddressUse.AsBoolean = true then begin
Inc(iBegRowTitle);
Sheets.Cells[iBegRowTitle,iColForRekv]:=tRekvRAddress.AsString;
end;
if tRekvRTelUse.AsBoolean = true then begin
Inc(iBegRowTitle);
Sheets.Cells[iBegRowTitle,iColForRekv]:='Тел/Факс: '+tRekvRTel.AsString;
end;
if tRekvREMailUse.AsBoolean = true then begin
Inc(iBegRowTitle);
Sheets.Cells[iBegRowTitle,iColForRekv]:='e-mail: '+tRekvREMail.AsString;
end;
if tRekvROKPOUse.AsBoolean = true then begin
Inc(iBegRowTitle);
Sheets.Cells[iBegRowTitle,iColForRekv]:='ОКПО: '+tRekvROKPO.AsString;
end;
if tRekvRINNUse.AsBoolean = true then begin
Inc(iBegRowTitle);
Sheets.Cells[iBegRowTitle,iColForRekv]:='ИНН: '+tRekvRINN.AsString;
end;
if tRekvRSvidNdsUse.AsBoolean = true then begin
Inc(iBegRowTitle);
Sheets.Cells[iBegRowTitle,iColForRekv]:='№ свид плат. НДС: '+tRekvRSvidNds.AsString;
end;
if tRekvRBankUse.AsBoolean = true then begin
Inc(iBegRowTitle);
Sheets.Cells[iBegRowTitle,iColForRekv]:='Банк: '+tRekvRBank.AsString;
end;
if tRekvRGorBankUse.AsBoolean = true then begin
Inc(iBegRowTitle);
Sheets.Cells[iBegRowTitle,iColForRekv]:='Город банка: '+tRekvRGorBank.AsString;
end;
if tRekvRMFOUse.AsBoolean = true then begin
Inc(iBegRowTitle);
Sheets.Cells[iBegRowTitle,iColForRekv]:='МФО: '+tRekvRMFO.AsString;
end;
if tRekvRRSUse.AsBoolean = true then begin
Inc(iBegRowTitle);
Sheets.Cells[iBegRowTitle,iColForRekv]:='Р/счет: '+tRekvRRS.AsString;
end;
if tRekvRLicenzeUse.AsBoolean = true then begin
Inc(iBegRowTitle);
Sheets.Cells[iBegRowTitle,iColForRekv]:='Лицензия: '+tRekvRLicenze.AsString;
end;
Inc(iBegRowTitle,2);
Sheets.Cells[iBegRowTitle,3]:='НАКЛАДНАЯ № '+tNaklsNNumber.AsString;
Range:=Sheets.Cells[iBegRowTitle,3];
Range.HorizontalAlignment := xlCenter;
Range.VerticalAlignment := xlCenter;
Range:=Sheets.Cells[iBegRowTitle,3];
Range.Font.Bold:=True;
Inc(iBegRowTitle);
Sheets.Cells[iBegRowTitle,3]:='от '+ tNaklsNDate.AsString;
Range:=Sheets.Cells[iBegRowTitle,3];
Range.HorizontalAlignment := xlCenter;
Range.VerticalAlignment := xlCenter;
Inc(iBegRowTitle);
Sheets.Cells[iBegRowTitle,1]:='Филиал: '+ tNaklsNFilial2.AsString;
Inc(iBegRowTitle,2);
Inc(iBegRowTitle);
Sheets.Cells[iBegRowTitle,1]:='Через кого ____________________';
Inc(iBegRowTitle,2);
//заголовки столбцов
iBegRow:=iBegRowTitle;//начальная строка для преператов
vRow:=iBegRow+1;
tNaklsDet.First;
For iColCount:=0 to dbGridNaklsDet.Columns.Count-1 do begin
Sheets.Cells[iBegRow,iColCount+1]:=dbGridNaklsDet.Columns[iColCount].Title.Caption;
Sheets.Cells[iBegRow,iColCount+1].ColumnWidth:=dbGridNaklsDet.Columns[iColCount].Width div 6;
Range:=Sheets.Cells[iBegRow,iColCount+1];
Range.Font.Bold:=True;
//рисуем border
Range.Borders[1].LineStyle := 1;
Range.Borders[2].LineStyle := 1;
Range.Borders[3].LineStyle := 1;
Range.Borders[4].LineStyle := 1;
end;
//заполнение таблицы
while not tNaklsDet.Eof do begin
For iColCount:=0 to dbGridNaklsDet.Columns.Count-1 do begin
Range:=Sheets.Cells[vRow,iColCount+1];
Case tNaklsDet.FieldByName(dbGridNaklsDet.Columns[iColCount].FieldName).DataType of
ftFloat : begin
Range.NumberFormat := '0,000';
Sheets.Cells[vRow,iColCount+1]:=
tNaklsDet.FieldByName(dbGridNaklsDet.Columns[iColCount].FieldName).AsFloat
end;
ftString : begin
Range.NumberFormat := '@';
Sheets.Cells[vRow,iColCount+1]:=
tNaklsDet.FieldByName(dbGridNaklsDet.Columns[iColCount].FieldName).AsString;
end;
ftInteger : begin
Range.NumberFormat := '0';
Sheets.Cells[vRow,iColCount+1]:=
tNaklsDet.FieldByName(dbGridNaklsDet.Columns[iColCount].FieldName).AsInteger;
end;
ftDate : begin
Range.NumberFormat := '@';
dDate:=tNaklsDet.FieldByName(dbGridNaklsDet.Columns[iColCount].FieldName).AsDateTime;
Sheets.Cells[vRow,iColCount+1]:=FormatDateTime('dd.mm.yyyy',dDate);
end
else
Range.NumberFormat := '@';
Sheets.Cells[vRow,iColCount+1]:=
tNaklsDet.FieldByName(dbGridNaklsDet.Columns[iColCount].FieldName).AsString;
end;//case-else
try
if tNaklsDet.FieldByName(dbGridNaklsDet.Columns[iColCount].FieldName).DataType = ftFloat then
if tNaklsDet.FieldByName(dbGridNaklsDet.Columns[iColCount].FieldName).AsFloat = 0 then
Sheets.Cells[vRow,iColCount+1]:=' ';
except
end;
//рисуем border
Range.Borders[1].LineStyle := 1;
Range.Borders[2].LineStyle := 1;
Range.Borders[3].LineStyle := 1;
Range.Borders[4].LineStyle := 1;
end;// FOR
Inc(vRow);
tNaklsDet.Next;
end;//WHILE
//отпарвляем итоги
if (StrToFloatDef(dbGridNaklsDet.Columns[6].Footer.Value,0)<>0) AND
(dbGridNaklsDet.Columns[6].Visible) then begin
iColSum:=dbGridNaklsDet.Columns[6].Index+1;//колонка для суммы
Sheets.Cells[vRow,3]:='ИТОГО:';
Range:=Sheets.Cells[vRow,iColSum];
Range.HorizontalAlignment := xlRight;
Range.VerticalAlignment := xlCenter;
Range.NumberFormat := '0,000';
try
Sheets.Cells[vRow,iColSum]:=StrToFloatDef(dbGridNaklsDet.Columns[6].Footer.Value,0);
except
Range.NumberFormat := '@';
Sheets.Cells[vRow,iColSum]:=dbGridNaklsDet.Columns[6].Footer.Value;
end;
end;
Inc(vRow,2);
Sheets.Cells[vRow,1]:='Отпустил ______________';
Inc(vRow,2);
Sheets.Cells[vRow,1]:='Получил _______________';
//удаляем лишние столбцы (по умолчанию со сдвигом влево)
For iColCount:= dbGridNaklsDet.Columns.Count-1 downto 0 do begin
if dbGridNaklsDet.Columns[iColCount].Visible=False then begin
UsedRange := Sheets.Range['A1','Z100'];//диапазон поиска
Range := UsedRange.Find(What:=dbGridNaklsDet.Columns[iColCount].Title.Caption, LookIn := xlValues, LookAt := xlWhole,SearchDirection := xlNext);
if not VarIsEmpty(Range)then begin
try
FirstAddress := Range.Address;
s:=StringReplace(FirstAddress,'$','',[rfReplaceAll]);
Range:=Sheets.Range[s+':'+Copy(s,1,1)+IntToStr(vRow)];
Range.Delete;
except
end;//try-except
end;//if not VarIsEmpty(Range)then begin
end;//if dbGridZay.Columns[iColCount].Visible=False then begin
end;//for delete
finally
tNakls.EnableControls;
tNaklsDet.EnableControls;
Screen.Cursor:=crDefault;
tRekv.Close;
NaklsToExcel.Visible:=True;
end;//finally
end;//with
end;
|
|
