[Aristarh Dark]

Этот вопрос очень часто задают на форуме. Я решил не жадничать и поделиться небольшой своей наработкой. Т.к. много писать я не люблю смотрите код:

Код:

unit ExportToExcel;
{
  Модуль для передачи данных в Excel из любого наследника TDataSet

  (c) Aristarh Dark (2010)
  e-mail: aristarh.dark@gmail.com

  Зависимости:
  DB, SysUtils, ComObj, Variants, Math;

  Небольшое описание:
  ds              - набор данных по которому надо построить таблицу в эксель
  TableName       - выводимый заголовок таблицы
  Names           - вариантрый массив имен столбцов, имена должны следовать в том же
                    порядке, что и выводимые поля в наборе данных
  NotOut          - вариантный массив имен полей набора данных которые выводить не
                    следует, поля в массиве следовали в том же порядке что и в наборе
  isDeletePresent - это моя собственная примочка, т.к. в любой таблице я использую
                    поле isDeleted (признак удаленной записи), то такие записи я
                    хотел бы видеть и в результирующей таблице в Excel. В моем
                    варианте они выделяются курсивом.

  Модуль свободен для использования и изменения, ссылка на автора желательна

  Тестировалось на Excel 2003
}
interface
uses
  DB;

procedure ToExcel(ds:TDataSet;TableName:String;Names,NotOut:Variant;isDeletePresent:boolean = True);

implementation
uses
  SysUtils, ComObj, Variants, Math;

const
  TitleRow          = '2';
  TitleCol          = 'B';
  TitleFontName     = 'Times New Roman';
  TitleFontSize     = 12;

  TableHeadRow      = '4';
  TableHeadStartCol = 'B';
  TableHeadFontName = 'Courier New';
  TableHeadFontSize = 12;

  TableDataStartRow = '5';
  TableDataStartCol = 'B';
  TableDataFontName = 'Courier New';
  TableDataFontSize = 12;

function ExInc(value:string;delta:integer = 1;trend:boolean = true):string;
{
   Сложение/вычитание координат Excel
   value - значение (буквенная координата столбца)
   delta - коэффициент приращения [1]
   trend - направление приращения .t. - сложение, .f. - вычитание [.t.]

   ВНИМАНИЕ!!
   работает только до 'ZZ'
}
var
  numeric:integer;
  low,hig:integer;
begin
  if not(trend) then
    delta:=delta*(-1);
  //распаковка
  if Length(value)>1 then
     numeric:=(ord(value[1])-64)*26+(ord(value[2])-64)
  else
     numeric:=ord(value[1])-64;
  numeric:=numeric+delta;
  //упаковка
  if numeric>26 then
    begin
      low:=numeric-(26*Trunc(numeric/26));
      hig:=Trunc(numeric/26);
      if low=0 then
        begin
          low:=26;
          hig:=hig-1;
        end;
      result:=chr(hig+64)+chr(low+64);
    end
  else
     result:=chr(64+numeric);
end;


function CheckField(FieldName:string;Data:Variant):boolean;
var
  i:integer;
begin
  Result:=True;
  for i:=VarArrayLowBound(data,1) to VarArrayHighBound(data,1) do
    if AnsiUpperCase(FieldName)=AnsiUpperCase(data[i]) then
      Result:=False;
end;
procedure ToExcel(ds:TDataSet;TableName:String;Names,NotOut:Variant;isDeletePresent:boolean = True);
var
  Excel:OleVariant;
  Sheet:OleVariant;
  Data:Variant;
  i,j:integer;
  counter:integer;
  NoOutFieldsPresent:boolean;
  NoOutCounter:integer;
  NoOutCounterNeedInc:boolean;
  TableWidth:integer;
  RangeStr:String;
begin
  NoOutFieldsPresent:=False;
  //Предварительная подготовка
  Excel:=CreateOleObject('Excel.Application');
  Excel.WorkBooks.Add;
  Sheet:=Excel.WorkBooks[1].ActiveSheet;
  Excel.Visible:=True;
  //Наименования стролбцов
  if VarType(Names) and VarArray = VarArray then
    begin
      //Вывод наименований столбцов
      counter:=0;
      for i:=VarArrayLowBound(Names,1) to VarArrayHighBound(Names,1) do
        begin
          RangeStr:=Format('%s%s',[ExInc(TableHeadStartCol,counter),TableHeadRow]);
          Sheet.Range[RangeStr].Value:=Names[i];
          Sheet.Range[RangeStr].HorizontalAlignment:=$FFFFEFF4;
          Sheet.Range[RangeStr].VerticalAlignment:=$FFFFEFF4;
          Sheet.Range[RangeStr].Font.Bold:=True;
          Sheet.Range[RangeStr].Font.Name:=TableHeadFontName;
          Sheet.Range[RangeStr].Font.Size:=TableHeadFontSize;
          inc(Counter);
        end;
    end;
  //"Невыводимые" поля
  if VarType(NotOut) and VarArray = VarArray then
    begin
      Data:=VarArrayCreate([1,ds.RecordCount,1,ds.Fields.Count-VarArrayHighBound(NotOut,1)],varVariant);
      NoOutFieldsPresent:=true;
    end
  else
    Data:=VarArrayCreate([1,ds.RecordCount,1,ds.Fields.Count],varVariant);
  //Расчет "ширины" таблицы, очевидна что она будет равна количеству столбцов
  TableWidth:=VarArrayHighBound(data,2);
  //Наименование таблицы
  Sheet.Range[Format('%s%s',[TitleCol,TitleRow])].Value:=TableName;
  RangeStr:=Format('%s%s:%s%s',[TitleCol,TitleRow,ExInc(TitleCol,TableWidth-1),TitleRow]);
  Sheet.Range[RangeStr].Merge;
  Sheet.Range[RangeStr].HorizontalAlignment:=$FFFFEFF4;
  Sheet.Range[RangeStr].VerticalAlignment:=$FFFFEFF4;
  Sheet.Range[RangeStr].Font.Bold:=True;
  Sheet.Range[RangeStr].Font.Name:=TitleFontName;
  Sheet.Range[RangeStr].Font.Size:=TitleFontSize;
  NoOutCounter:=1;
  NoOutCounterNeedInc:=False;
  for i:=1 to ds.Fields.Count do
    begin
      ds.First;
      if NoOutCounterNeedInc then
        begin
          inc(NoOutCounter);
          NoOutCounterNeedInc:=False;
        end;
      for j:=1 to ds.RecordCount do
        begin
          if NoOutFieldsPresent then
            begin
              if CheckField(ds.Fields[i-1].FieldName,NotOut) then
                begin
                  Data[j,NoOutCounter]:=ds.Fields[i-1].Value;
                  NoOutCounterNeedInc:=True;
                end;
            end
          else
            begin
              Data[j,i]:=ds.Fields[i-1].Value;
            end;
          ds.Next;
        end
    end;
  if VarType(NotOut) and VarArray = VarArray then
    begin
      RangeStr:=Format('%s%s:%s%d',[TableDataStartCol,TableDataStartRow,chr(65+IfThen(NoOutFieldsPresent,ds.Fields.Count-VarArrayHighBound(NotOut,1),ds.Fields.Count)),4+ds.RecordCount]);
      Sheet.Range[RangeStr].Value:=Data;
    end
  else
    begin
      RangeStr:=Format('%s%s:%s%d',[TableDataStartCol,TableDataStartRow,chr(65+ds.Fields.Count),4+ds.RecordCount]);
      Sheet.Range[RangeStr].Value:=Data;
    end;
  //Украшательство
  Sheet.Range[RangeStr].Font.Name:=TableDataFontName;
  Sheet.Range[RangeStr].Font.Size:=TableDataFontSize;
  //Удаленнные записи
  if isDeletePresent then
    begin
      ds.First;
      for i:=1 to ds.RecordCount do
        begin
          if ds.FieldByName('isDeleted').AsBoolean then
            begin
              //Рассчет нахождения удаленной строки
              RangeStr:=Format('%d:%d',[StrToInt(TableDataStartRow)+i-1,StrToInt(TableDataStartRow)+i-1]);
              //Украшалка
              Sheet.Range[RangeStr].Font.Italic:=True;
            end;
          ds.Next;
        end;
    end;
  //Последнее украшательство
  Sheet.Cells.Select;
  Sheet.Cells.EntireColumn.AutoFit;
  Sheet.Range['A1'].Select;
end;

end.