Fórum gerar .xls #295837

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.