[NumLock]

Код:

unit Friday;

interface

uses
  ComObj, Variants, DB;

procedure DataSetToExcel(DataSet: TDataSet; Name: string;
  FieldsName: Boolean = True; AFileName: string = ''; AutoFit: Boolean = True);

implementation

const
  xlWBATWorksheet = $FFFFEFB9;

  xlExcel2 = $00000010;
  xlExcel3 = $0000001D;
  xlExcel4 = $00000021;
  xlExcel5 = $00000027;
  xlExcel7 = $00000027;
  xlExcel9795 = $0000002B;

procedure DataSetToExcel(DataSet: TDataSet; Name: string;
  FieldsName: Boolean = True; AFileName: string = ''; AutoFit: Boolean = True);
var
  ExcelApplication: OleVariant;
  ExcelWorkbook: OleVariant;
  ExcelWorksheet: OleVariant;
  row, col: Integer;
  i: Integer;
begin
  ExcelApplication:=CreateOleObject('Excel.Application');
  try
    ExcelWorkbook:=ExcelApplication.Workbooks.Add(xlWBATWorksheet);
    ExcelWorksheet:=ExcelWorkbook.Sheets.Item[1];
    ExcelWorksheet.Name:=Name;

    row:=1;
    col:=1;
    if FieldsName then
    begin
      for i:=0 to DataSet.FieldDefs.Count-1 do
      begin
        ExcelWorksheet.Cells.Item[row, col]:=DataSet.FieldDefs[i].Name;
        Inc(col);
      end;
      Inc(row);
    end;

    DataSet.DisableControls;
    DataSet.First;
    try
      while not DataSet.Eof do
      begin
        col:=1;
        for i:=0 to DataSet.Fields.Count-1 do
        begin
          ExcelWorksheet.Cells.Item[row, col]:=DataSet.Fields[i].AsString;
          Inc(col);
        end;
        Inc(row);
        DataSet.Next;
      end;
    finally
      DataSet.EnableControls;
    end;

    if AutoFit then ExcelWorksheet.Columns.EntireColumn.AutoFit;
    ExcelApplication.Visible:=True;

    if AFileName<>'' then
      ExcelWorkbook.SaveAs(Filename:=AFileName, FileFormat:=xlExcel7);
  finally
    ExcelApplication.Quit;
    ExcelApplication:=Null;
  end;
end;

end.