Exportar para o Excel

Delphi - Exportar para o Excel

// Baseado num exemplo encontrado em:

// { http://www.swissdelphicenter.ch/torry/showcode.php?id=379 }

// Uses Windows, DB, Variants, ComObj, SysUtils;

function ExportarParaExcel(DataSet: TDataSet; xlOrientacao: Integer): Boolean;

   function RefToCell(RowID, ColID: Integer): String;

   var

     ACount, APos: Integer;

   begin

     ACount := ColID div 26;

     APos := ColID mod 26;

     if APos = 0 then

     begin

       ACount := ACount - 1;

       APos := 26;

     end;

     if ACount = 0 then

       Result := Chr(Ord('A') + ColID - 1) + IntToStr(RowID)

     else if ACount = 1 then

       Result := 'A' + Chr(Ord('A') + APos - 1) + IntToStr(RowID)

     else

       Result := Chr(Ord('A') + ACount - 1) + Chr(Ord('A') + APos - 1) + IntToStr(RowID);

   end;

const

   xlWBatWorkSheet = -4167;

var

   XLApp, Sheet, Data: OLEVariant;

   linha, coluna: Integer;

   nRec: TBookmark;

begin

   Result := False;

   // Prepara os dados

   Data := VarArrayCreate([1, DataSet.RecordCount+1, 1, DataSet.FieldCount], varVariant);

   // Obs: DataSet.RecordCount + 1 -> ( + 1 ) é por causa dos nomes das colunas.

   linha := 1;

   for coluna := 0 to Pred(DataSet.FieldCount) do

   begin

      Data[linha, coluna + 1] := DataSet.Fields[coluna].DisplayLabel;

   end;

   nRec := DataSet.GetBookmark;

   try

      with DataSet do

      begin

         DisableControls;

         First;

         while not eof do

         begin

            inc(linha);

            for coluna := 0 to Pred(DataSet.FieldCount) do

            begin

               Data[linha, coluna + 1] := DataSet.Fields[coluna].Value;

            end;

            Next;

         end;

      end;

      // Cria o objeto Excel-OLE

      XLApp := CreateOleObject('Excel.Application');

      try

         // Esconde o Excel

         XLApp.Visible := False;

         // Adiciona um novo Workbook

         XLApp.Workbooks.Add(xlWBatWorkSheet);

         Sheet := XLApp.Workbooks[1].WorkSheets[1];

         // Preenche a planilha

         Sheet.Range[RefToCell(1, 1), RefToCell(DataSet.RecordCount+1, DataSet.FieldCount)].Value := Data;

         Sheet.Range[RefToCell(1, 1), RefToCell(DataSet.RecordCount+1, DataSet.FieldCount)].EntireColumn.AutoFit;

         XLApp.Workbooks[1].WorkSheets[1].PageSetup.Orientation := xlOrientacao;

         XLApp.Visible := True;

         Result := True;

      Except

         // Fecha o Excel, sem nenhuma mensagem

         if not VarIsEmpty(XLApp) then

         begin

            XLApp.DisplayAlerts := False;

            XLApp.Quit;

            XLAPP := Unassigned;

            Sheet := Unassigned;

         end;

      end;

   finally

      Dataset.GotoBookmark(nRec);

      Dataset.FreeBookmark(nRec);

      Dataset.EnableControls;

   end;

end;

//

// Exemplo de uso:

//

procedure TForm1.BitBtn1Click(Sender: TObject);

const xlOrientacao: Integer = 2;

// 1= xlPortrait

// 2= xlLandscape;

begin

   if not ExportarParaExcel(ClientDataSet1, xlOrientacao) then

     ShowMessage('Erro na exportação para o Excel.');

end;