excelout.~pas

针对信息进行帅选Delphi筛选系统

unit ExcelOut;

interface
   uses
        Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
        Grids, DBGrids, StdCtrls,ComCtrls,Variants , ComObj, ADODB;

   procedure OutputExcel(DbgCtrl:TDBGrid); overload;
   procedure OutputExcel(LVCtrl:TListView); overload;
   
implementation

uses Showhit;

procedure OutputExcel(DbgCtrl: TDBGrid); overload;
var 
  exlApp,wBook:Variant;
  nCol,nRow,i,j:integer;
  sdExcel:TSaveDialog;
  filename:string;
begin
    nRow:=DbgCtrl.DataSource.DataSet.RecordCount;
    nCol:=DbgCtrl.Columns.Count;
    if nRow<1 then
    begin
        MessageBox(DbgCtrl.Handle,PChar('没有任何数据可供导出！'),PChar('提示'),MB_OK+MB_ICONINFORMATION);
        exit;
    end;
    if nRow>9999 then
    begin
        if MessageBox(DbgCtrl.Handle,PChar('数据太多，将导致导出时间较长或Excel文件溢出，是否继续？'),PChar('警告'),MB_YESNO + MB_ICONINFORMATION)=IDNO then
            exit;
    end;
    sdExcel:=TSaveDialog.Create(DbgCtrl);
    sdExcel.Filter := 'Excel files (*.xls)|*.XLS';
    if sdExcel.Execute then
    begin
        FileName:=sdExcel.FileName;

        if UpperCase(copy(filename,length(filename)-2,3))<>'XLS' then
        //if Pos('XLS',UpperCase(filename))<>length(filename)-4 then
           FileName := FileName+'.XLS';
        if fileexists(FileName) then
        try
           deletefile(FileName);
        except
           messagebox(DbgCtrl.Handle,'文件删除失败','提示',mb_ok+mb_iconinformation);
           sdExcel.Free;
           exit;
        end;
    end
    else
    begin
        sdExcel.Free;
        exit;
    end;
    sdExcel.Free;
    try
     //创建OLE对象Excel Application与 WorkBook
        exlApp:=CreateOleObject('Excel.Application');
        wBook:=CreateOleobject('Excel.Sheet');
    except
        ShowMessage('您的机器里未安装Microsoft Excel。');
        Exit;
    end;
     showmessage('111');
    try
        wBook:=exlApp.workBooks.Add;
        DbgCtrl.DataSource.DataSet.First;
        for i:=0 to nCol-1 do
        begin
           exlApp.Cells(1,i+1):=DbgCtrl.Columns[i].Title.Caption;
        end;
        for j:=0 to nRow-1 do
        begin
            for i:=0 to nCol-1 do
               exlApp.Cells(j+2,i+1):=DbgCtrl.DataSource.DataSet.FieldValues[DbgCtrl.Columns.Items[i].DisplayName];
            DbgCtrl.DataSource.DataSet.Next;
        end;
        wBook.saveas(filename);
        wBook.close;
        exlApp.Quit;
        //退出Excel Application
        //释放VARIANT变量
        exlApp:=Unassigned;
        MessageBox(DbgCtrl.Handle,PChar('总共  '+IntToStr(nRow)+'  条记录导出完毕。'),PChar('完成'),MB_OK+MB_ICONINFORMATION);
    except
        ShowMessage('不能正确操作Excel文件。可能是该文件已被其他程序打开,或系统错误。');
        wBook.close;
        exlApp.Quit;
        //释放VARIANT变量
        exlApp:=Unassigned;
    end;
end;

procedure OutputExcel(LVCtrl:TListView); overload;
var
  exlApp,wBook:Variant;
  nCol,nRow,i,j:integer;
  sdExcel:TSaveDialog;
  filename:string;
   ShowHit:TshowhitForm;
begin
    nRow:=LVCtrl.Items.Count;
    nCol:=LVCtrl.Columns.Count;
    if nRow<1 then
    begin
        MessageBox(LVCtrl.Handle,PChar('没有任何数据可供导出！'),PChar('提示'),MB_OK+MB_ICONINFORMATION);
        exit;
    end;
    if nRow>9999 then
    begin
        if MessageBox(LVCtrl.Handle,PChar('数据太多，将导致导出时间较长或Excel文件溢出，是否继续？'),PChar('警告'),MB_YESNO + MB_ICONINFORMATION)=IDNO then
            exit;
    end;
    sdExcel:=TSaveDialog.Create(LVCtrl);
    sdExcel.Filter := 'Excel files (*.xls)|*.XLS';
    if sdExcel.Execute then
    begin
        FileName:=sdExcel.FileName;
        if UpperCase(copy(filename,length(filename)-2,3))<>'XLS' then
           FileName := FileName+'.XLS';
        if fileexists(FileName) then
        try
           deletefile(FileName);
        except
           messagebox(LVCtrl.handle,'文件删除失败','提示',mb_ok+mb_iconinformation);
           sdExcel.Free;
           exit;
        end;
    end
    else
    begin
        sdExcel.Free;
        exit;
    end;
    sdExcel.Free;
    try
     //创建OLE对象Excel Application与 WorkBook
        exlApp:=CreateOleObject('Excel.Application');
        wBook:=CreateOleobject('Excel.Sheet');
    except
        ShowMessage('您的机器里未安装Microsoft Excel。');
        Exit;
    end;
   showhit:=TShowHitForm.Create();
   ShowHit.SetStatus('正在筛选中.....请稍后！');
   ShowHit.Show;
   showhit.Repaint;
    try
        wBook:=exlApp.workBooks.Add;
        for i:=0 to nCol-1 do
        begin
           exlApp.Cells(1,i+1):=LVCtrl.Columns.Items[i].Caption;
        end;
        for j:=0 to nRow-1 do
        begin
           exlApp.Cells(j+2,1):=LVCtrl.Items[j].Caption;
           for i:=0 to nCol-2 do exlApp.Cells(j+2,i+2):=LVCtrl.Items[j].SubItems[i];
        end;
        wBook.saveas(filename);
        wBook.close;
        exlApp.Quit;
        //退出Excel Application
        //释放VARIANT变量
        exlApp:=Unassigned;
        MessageBox(LVCtrl.Handle,PChar('总共  '+IntToStr(nRow)+'  条记录导出完毕。'),PChar('完成'),MB_OK+MB_ICONINFORMATION);
    except
        showhit.Hide;
        showhit.Free;
        ShowMessage('不能正确操作Excel文件。可能是该文件已被其他程序打开,或系统错误。');
        wBook.close;
        exlApp.Quit;
        //释放VARIANT变量
        exlApp:=Unassigned;
    end;
    showhit.Hide;
    showhit.Free;
end;

end.