delphi 将Query的结果导出到Excel

目标：将Query的查询结果输出到Excel

interface

uses
ComObj, DB;

var
    function DataSetToExcel(DataSet:TDataSet;FieldTagMax:Integer;Visible:Boolean;ExcelFileName:String=''): Boolean;
    function DataSetToExcelSheet(DataSet:TDataSet;FieldTagMax:Integer;Sheet:OleVariant): Boolean;

function DataSetToExcelSheet(DataSet:TDataSet;FieldTagMax:Integer;Sheet:OleVariant): Boolean;
var
  Row,Col,FieldIndex :Integer;
  BK:TBookMark;
  //StrCell:string;
  //FFieldNames : TStrings;
begin 
     Result := False;
     if not Dataset.Active then exit;
       BK:=DataSet.GetBookMark;
       DataSet.DisableControls;

       Sheet.Activate;

     try
     //  FFieldNames:=TStringList.Create;
     //  FFieldNames.clear;
       // 列标题
       Row:=1;
       Col:=1;
       for FieldIndex:=0 to DataSet.FieldCount-1 do
         begin
           if DataSet.Fields[FieldIndex].Tag <= FieldTagMax then
           begin
              Sheet.Cells[Row,Col] :=DataSet.Fields[FieldIndex].DisplayLabel;
         //     FFieldNames.Add(dataset.Fields[fieldindex].FieldName);
              Inc(Col);
           end;
         end;
      // 表内容
       DataSet.First;
       while Not DataSet.Eof do
       begin
          Row:=Row+1;
          Col:=1;
          for FieldIndex:=0 to DataSet.FieldCount-1 do
            begin
               if DataSet.Fields[FieldIndex].Tag <= FieldTagMax then
                begin
                 if dataset.fields[fieldindex].DataType= ftfloat then
                  Sheet.Cells[Row,Col]:=DataSet.Fields[FieldIndex].asstring
                 else
                 // sheet.cells(row,col):=''''+dataset.fields[fieldindex].Asstring;
                //  sheet.Range(row,col).value:= dataset.fields[fieldindex].asstring;
                  begin
                    //StrCell:=GetColumnCharacters(col)+IntToStr(Row);
                    //sheet.range[strcell,strcell].value:=dataset.FieldByName(FFieldNames[fieldindex]).asstring ;//dataset.fields[fieldindex].asstring;
                    sheet.cells[row,col].numberformat:='@';
                    sheet.cells[row,col]:=dataset.fields[fieldindex].Asstring;
                  end;
                 Inc(Col);
                end;
            end;
          DataSet.Next;
       end;

        Result := True;
     finally
       DataSet.GotoBookMark(BK);
       //FFieldNames.free;
       DataSet.EnableControls;
     end;
end;

function DataSetToExcel(
DataSet:TDataSet;FieldTagMax:Integer;
Visible:Boolean;ExcelFileName:String=''): Boolean;
var
  ExcelObj, Excel, WorkBook, Sheet: OleVariant;
  OldCursor:TCursor;
  SaveDialog:TSaveDialog;
begin
   Result := False;
   if not Dataset.Active then exit;

   OldCursor:=Screen.Cursor;
   Screen.Cursor:=crHourGlass;

   try
     ExcelObj := CreateOleObject('Excel.Sheet');
     Excel := ExcelObj.Application;
     Excel.Visible := Visible ;
     WorkBook := Excel.Workbooks.Add ;
     Sheet:= WorkBook.Sheets[1];
   except
       MessageBox(GetActiveWindow,'无法调用Mircorsoft Excel! '+chr(13)+chr(10)+
       '请检查是否安装了Mircorsoft Excel。','提示',MB_OK+MB_ICONINFORMATION);
       Screen.Cursor:=OldCursor;
       Exit;
   end;

   Result:=DataSetToExcelSheet(DataSet,FieldTagMax,Sheet) ;
   if Result then
      if Not Visible then
       begin
           if ExcelFileName<>'' then
              WorkBook.SaveAs(FileName:=ExcelFileName)
           else
           begin
            SaveDialog:=TSaveDialog.Create(Nil);
            SaveDialog.Filter := 'Microsoft Excel 文件|*.xls';
            Result:=SaveDialog.Execute;
            UpdateWindow(GetActiveWindow);
            if Result then
              WorkBook.SaveAs(FileName:=SaveDialog.FileName);
              SaveDialog.Free;
           end;
          Excel.Quit;
       end;
   Screen.Cursor:=OldCursor;
end;

按钮动作：
 if Application.MessageBox('要导出为Excel文件吗？', '提示', MB_YESNO + 
    MB_ICONQUESTION) = IDYES then
    begin
      DataSetToExcel(dm.qry1,1,false,'');
      Application.MessageBox('恭喜，导出成功！', '提示', MB_OK +
      MB_ICONINFORMATION);
    end
 else
    Exit;