unit1.pas

指定格式導入excel,指定格式導入excelm

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    DBGrid1: TDBGrid;
    DataSource1: TDataSource;
    Button1: TButton;
    ADOQuery1: TADOQuery;
    SaveDialog1: TSaveDialog;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure GenXlsFile(sDataSet:TADOQuery;Fn:String;Vis:Boolean);
//uses ComObj;
var
  ExcelApp: Variant;
  i,j:integer;
begin
  try
    ExcelApp := CreateOleObject('Excel.Application');
  except
    application.MessageBox('系统中的MS Excel软件没有安装或安装不正确！','错误',MB_ICONERROR+MB_OK);
    exit;
  end;
  ExcelApp.visible:=vis;
  try
    excelapp.caption:='应用程序调用 Microsoft Excel';
    ExcelApp.WorkBooks.Add;
    //写入标题行
    for i:=1 to sDataSet.Fields.Count do
    begin
      ExcelApp.Cells[1,i].Value :=sDataSet.Fields[i-1].DisplayName;
    end;
    sDataSet.First;
    i:=2;
    while not sDataSet.Eof do
    begin
       for j:=0 to sDataSet.Fields.Count-1 do
       begin
          ExcelApp.Cells[i,j+1].Value :=sDataSet.Fields[j].AsString;
       end;
       sDataSet.Next;
       i:=i+1;
    end;
    sDataSet.First;
    if application.MessageBox('数据导出完成.确认保存吗？','问题',MB_ICONQUESTION+MB_YESNO+MB_DEFBUTTON1+MB_SYSTEMMODAL)=IDYES then
    begin
      if not ExcelApp.ActiveWorkBook.Saved then
         ExcelApp.ActiveWorkBook.SaveAs(fn);
    end
    else begin
      ExcelApp.ActiveWorkBook.Saved := True; //不保存
    end;
  finally
    excelapp.quit; //退出EXCEL软件
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var FN:String;
begin
//  GenXlsFile(ADOQuery1,'d:\luozs.xls',False);
if SaveDialog1.Execute then
  begin
    fn:=SaveDialog1.FileName;
    GenXlsFile(ADOQuery1,fn,False);
  end;
end;

end.