usavetoexcel.~pas

图书管理系统

unit USaveToExcel;

interface
   uses variants,comobj,dbgrids,windows,Db,dialogs;
function SaveToExecl(aDBGrid:TDBGrid;aString,FileName:String): Boolean;
implementation
function SaveToExecl(aDBGrid:TDBGrid;aString,FileName:String): Boolean;
var
  MyExcel, WorkBook: Variant; //声明为OLE Automation 对象
  xlsFileName: string;
  i, j, n,count: integer;
begin
    Result:= False;
    xlsFileName := FileName;
    try
    //创建OLE对象Excel Application与 WorkBook
      MyExcel := CreateOleObject('Excel.Application');
      WorkBook := CreateOleobject('Excel.Sheet');
    except
      MessageBox(0, '您的机器里未安装Microsoft Excel.', '系统提示', MB_OK);
      Exit;
    end;
    try
      workBook := MyExcel.workBooks.Add;
      aDBGrid.DataSource.DataSet.First;
      i := 2;
      j := 1;
      //这行输入标题，谁有办法先把第一行的的单元格合并(合并列数等于字段数)
      MyExcel.Cells(1,1) := aString;
      for n:= 0 to aDBGrid.FieldCount - 1 do //输出字段名称
      begin
        MyExcel.Cells(i, j) := aDBGrid.Columns[n].Title.Caption;
        j := j + 1;
      end;
      if not aDBGrid.DataSource.DataSet.Active then
       begin
         ShowMessage('所对应的数据集没有打开！');
         MyExcel.ActiveWorkBook.close(true);
         MyExcel.Quit;
         Exit;
       end;
        i := 3;
      while not aDBGrid.DataSource.DataSet.Eof  do begin
        j := 2;
        for count:=0 to aDBGrid.FieldCount - 1 do //输出各字段值
        begin
          if aDBGrid.Columns[count].Field<>nil then
             MyExcel.Cells(i, j) :=aDBGrid.Columns[count].Field.asstring;
          j := j + 1;
        end;
        aDBGrid.DataSource.DataSet.Next; //数据指针下移
        i := i + 1;
      end;
      WorkBook.SaveAs(xlsFileName);
      MessageBox(0, '数据成功导出至Microsoft Excel.', '系统提示', mb_ok + mb_iconinformation);
      WorkBook.close;
      MyExcel.Quit; //退出Excel Application
      MyExcel := Unassigned; //释放VARIANT变量
      Result:= True;
    except
      MessageBox(0, '不能正确操作Excel文件。可能是该文件已被其他程序打开,或系统错误.', '系统提示', Mb_ok);
      WorkBook.close;
      MyExcel.Quit;
    //释放VARIANT变量
      MyExcel := Unassigned;
      Result:= False;
  end;
  end;

end.