Delphi中DBGRID导出到EXECL

mianfeiziyuan

procedure  DBGridInFoToExcel(FileName, TitleCaption: string;
MakeDataSource: TDataSource; makeDBGrid: TDBGrid;MakeType:Integer);
var
   xlApp, xlSheet: Variant;
   ARow, iLoop: word;
   text:string;
   //progressbar:TProgressBar;
begin
   if  MessageBox(GetActiveWindow,'数据导入EXCEL可能需要较长时间,是

否继续!','通知',MB_YESNO+MB_ICONQUESTION)<>IDYES THEN Exit;
   screen.Cursor:=crHourGlass;
   xlApp := CreateOleObject('Excel.Application');
   try
       xlSheet := CreateOleObject('Excel.Sheet');
       xlSheet := xlApp.WorkBooks.Add;

       // 主标题
         xlSheet.WorkSheets[1].Cells[1,1] := TitleCaption;
       //列标题
       if MakeType=0 then
         for iLoop := 0 to makeDBGrid.Columns.Count - 1 do
         xlSheet.WorkSheets[1].Cells[2, iLoop+1] :=

makeDBGrid.Columns[iLoop].Title.Caption;

       if MakeType=1 then
         for iLoop := 0 to MakeDataSource.dataset.Fields.Count-1  

do
         xlSheet.WorkSheets[1].Cells[2, iLoop+1] :=

MakeDataSource.dataset.Fields[iLoop].DisplayName;

       // 数据
       ARow :=3;
       with MakeDataSource.dataset do
       begin
         if IsEmpty then
         begin
         

messagebox(handle,'没有记录！','通知',mb_ok+MB_ICONWARNING);
         screen.Cursor:=crDefault;
         exit;
         end;
         DisableControls;
         First;
         while not Eof do
         begin
         if MakeType=0 then        //只取显示的表格的列
         for iloop:=1 to makeDBGrid.Columns.Count do
         begin
         

text:=fieldbyname(makeDBGrid.Columns[iloop-1].FieldName).Text;
         xlSheet.WorkSheets[1].Cells[ARow,

iLoop].value:=text;
         end;
         if MakeType=1 then    //取查询表所有列
         for iLoop := 1 to Fields.Count  do
         begin
         text:= Fields[iLoop-1].Text;
         xlSheet.WorkSheets[1].Cells[ARow,

iLoop].value:=text;
         end;
         Inc(ARow);
         Next;
         end;
         First;
         EnableControls;
       end;
         try
         if savedialog1.Execute then
         begin
         //xlSheet.SaveAs(FileName);
         xlSheet.SaveAs(savedialog1.FileName);
         screen.Cursor:=crDefault;
         Application.MessageBox('导出完毕!', '通知',

MB_IconExclamation);
         end;
         finally
         xlSheet.Close;
         xlApp.Quit;
         xlApp:= UnAssigned;
       end;
   except
         MessageBox(handle, '本机没有安装Excel.',

'通知',MB_IconExclamation);
         screen.Cursor:=crDefault;
   end;
end;