Fórum Exportando para o Excel #272834

unit DataSetToExcel;

interface

Uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Grids, DBGrids, ExtCtrls, StdCtrls, ComCtrls, Db, DBTables, DBCtrls,
  Buttons, ComObj, Filectrl,OleServer, Excel97;

  function DataSetToExcelFile(ds: TDataSet;ExcelFile: String):Boolean;

implementation

// Generate a Excel File (.xls) with the DataSource.DataSet
// property of the grid.
// Format the TFields of the DataSet to show in the Excel.
function DataSetToExcelFile(ds: TDataSet;ExcelFile: String):Boolean;
var bResult: Boolean;
    SavePlace: TBookmark;
    i,eline: Integer;
    Excel: TExcelApplication;
    r : Excel97.Range;
    w : _WorkBook;
    celula : string;
begin
  bResult:= False;
  // If dataset is assigned and active runs Excel
  if Assigned(ds) then
  begin
    if ds.Active then
    begin
      ds.DisableControls;
      try
        Excel:= TExcelApplication.Create(Application);
        Excel.Connect;
        Excel.Visible[0] := False;
        w := Excel.WorkBooks.Add(null,0);
        r := Excel.ActiveCell;
        // Save grid Position
        SavePlace:= ds.GetBookmark;
        ds.First;
        // Dataset Header
        eline:= 1; // First Line of Sheet
        if not (ds.Eof) then
        begin
          for i:=0 to (ds.FieldCount-1) do
          begin
            r.Value := ds.Fields[i].DisplayLabel;
            r := r.Next;
          end;
        end;
        while not ds.Eof do // Detail
        begin
          Inc(eline); // Add 1 to the line of Sheet
          celula := ´A´ + IntToStr(eline);
          r := Excel.Range[celula,celula];
          for i:=0 to (ds.FieldCount-1) do
          begin
            r.Value := ds.Fields[i].Value;
            r := r.Next;
          end;
          ds.Next;
        end;
        // Set saved grid position
        ds.GotoBookmark(SavePlace);
        // Save the file
        w.SaveAs(ExcelFile,null,null,null,null,null,ACCESS_OBJECT_GUID,null,null,null,null,0);
        w.Close(null,null,null,0);
        Excel.Disconnect;
        Excel.Quit;
        Excel.Free;
        bResult:= True;
      except
        on e:exception do
        begin
          showmessage(e.message);
          ds.EnableControls;
          bResult:= False;
        end;
      end;
    end;
  end;
  ds.EnableControls;
  Result := bResult;
end;

end.