首页 › Delphi/Pascal论坛 › delphi 导出到excel的7种方法

拾荒叔叔 發表於 2024-8-5 14:32:00

delphi 导出到excel的7种方法

<div class="postTitle"><span>delphi 导出到excel的7种方法</span></div>
<div class="postText">
<div id="cnblogs_post_body" class="blogpost-body blogpost-body-html">
<p>本文来自 爱好者8888 的CSDN 博客 ，全文地址请点击：https://blog.csdn.net/kpc2000/article/details/17066823?utm_source=copy</p>
<p>===================================================================================================</p>
<div class="user-info d-flex justify-content-center flex-column">
<p>第一种方法delphi 快速导出excel</p>
<div class="cnblogs_code">
<div class="cnblogs_code_toolbar"><span class="cnblogs_code_copy"><img src="https://assets.cnblogs.com/images/copycode.gif"></span></div>
<pre>uses ComObj,clipbrd;
function ToExcel(sfilename:string; ADOQuery:TADOQuery):boolean;
const
      xlNormal=-4143;
var
    y   : integer;
    tsList : TStringList;
    s,filename:string;
    aSheet :Variant;
    excel :OleVariant;
    savedialog:tsavedialog;
begin
    Result := true;
    try
         excel:=CreateOleObject('Excel.Application');
         excel.workbooks.add;
      except
            //screen.cursor:=crDefault;
         showmessage('无法调用Excel！');
         exit;
    end;
    savedialog:=tsavedialog.Create(nil);
    savedialog.FileName:=sfilename;   //存入文件    savedialog.Filter:='Excel文件(*.xls)|*.xls';
    if   savedialog.Execute   then
    begin
      if   FileExists(savedialog.FileName)   then
            try
                  if   application.messagebox('该文件已经存在，要覆盖吗？','询问',mb_yesno+mb_iconquestion)=idyes
   then
                        DeleteFile(PChar(savedialog.FileName))
                  else
                  begin
                   Excel.Quit;
                   savedialog.free;
                   //screen.cursor:=crDefault;
                   Exit;
                  end;
            except
                  Excel.Quit;
                  savedialog.free;
                  screen.cursor:=crDefault;
                  Exit;
            end;
      filename:=savedialog.FileName;
    end;
    savedialog.free;
    if   filename=''   then
    begin
      result:=true;
      Excel.Quit;
      //screen.cursor:=crDefault;
      exit;
    end;
    aSheet:=excel.Worksheets.Item;
    tsList:=TStringList.Create;
    //tsList.Add('查询结果');   //加入标题    s:='';   //加入字段名    for y := 0 to adoquery.fieldCount - 1 do
    begin
       s:=s+adoQuery.Fields.Fields.FieldName+#9 ;
       Application.ProcessMessages;
    end;
    tsList.Add(s);
    try
      try
            ADOQuery.First;
            While Not ADOQuery.Eof do
            begin
                s:='';
                for y:=0 to ADOQuery.FieldCount-1 do
                begin
                  s:=s+ADOQuery.Fields.AsString+#9;
                  Application.ProcessMessages;
                end;
                tsList.Add(s);
                ADOQuery.next;
            end;
            Clipboard.AsText:=tsList.Text;
      except
            result:=false;
      end;
    finally
      tsList.Free;
    end;
    aSheet.Paste;
    MessageBox(Application.Handle,'数据导出完毕！','系统提示',MB_ICONINFORMATION
or MB_OK);
    try
          if   copy(FileName,length(FileName)-3,4)&lt;&gt;'.xls'   then
                FileName:=FileName+'.xls';
          Excel.ActiveWorkbook.SaveAs(FileName,   xlNormal,   '',   '',   False,   False);
    except
      Excel.Quit;
      screen.cursor:=crDefault;
      exit;
    end;
    Excel.Visible   :=   false; //true会自动打开已经保存的excel
    Excel.Quit;
    Excel := UnAssigned;
   
end;</pre>
<div class="cnblogs_code_toolbar"><span class="cnblogs_code_copy"><img src="https://assets.cnblogs.com/images/copycode.gif"></span></div>
</div>
<p>调用: &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ToExcel('D:\a.xsl',QueryToExcel);//路径可以自定义</p>
<p>------------------------------------------------------------------------------------------------- *************************************************************************************************</p>
<p>二; delphi如何导出EXCEL，代码。非第3方控件首先在Uses处加上ComObj</p>
<div class="cnblogs_code">
<div class="cnblogs_code_toolbar"><span class="cnblogs_code_copy"><img src="https://assets.cnblogs.com/images/copycode.gif"></span></div>
<pre>procedure TForm1.Button1Click(Sender: TObject);
varh,k:integer;   
Excelid: OleVariant;   
s: string;
begin   
try      
Excelid := CreateOLEObject('Excel.Application');   
except      
Application.MessageBox('Excel没有安装！', '提示信息',
MB_OK+MB_ICONASTERISK+MB_DEFBUTTON1+MB_APPLMODAL);      
Exit;   
end;      
try   
   ADOQuery1.Close;      
ADOQuery1.SQL.Clear;      
ADOQuery1.SQL.Add('select * from jj_department');      
ADOQuery1.Open;      
k:=ADOQuery1.RecordCount;         
Excelid.Visible := True;         
Excelid.WorkBooks.Add;         
Excelid.worksheets.range['A1:c1'].Merge(True);         
Excelid.WorkSheets.Cells.Value :='部门编码表' ;         
Excelid.worksheets.Range['a1:a1'].HorizontalAlignment := $FFFFEFF4;         
Excelid.worksheets.Range['a1:a1'].VerticalAlignment := $FFFFEFF4;         
Excelid.WorkSheets.Cells.Value := '组别编号';         
Excelid.WorkSheets.Cells.Value := '公司编号';         
Excelid.WorkSheets.Cells.Value := '组别名称';         
Excelid.worksheets.Range['A1:c1'].Font.Name := '宋体';         
Excelid.worksheets.Range['A1:c1'].Font.Size := 9;         
Excelid.worksheets.range['A1:c2'].font.bold:=true;         
Excelid.worksheets.Range['A2:c2'].Font.Size := 9;         
Excelid.worksheets.Range['A2:c2'].HorizontalAlignment := $FFFFEFF4;         
Excelid.worksheets.Range['A2:c2'].VerticalAlignment := $FFFFEFF4;         
h:=3;         
ADOQuery1.First;      
while not ADOQuery1.Eof do         
begin         Excelid.WorkSheets.Cells.Value := Adoquery1.FieldByName('Fdept_id').AsString;         
Excelid.WorkSheets.Cells.Value := Adoquery1.FieldByName('Ffdept_id').AsString;         
Excelid.WorkSheets.Cells.Value := Adoquery1.FieldByName('Fdept_name').AsString;         
Inc(h);            
Adoquery1.Next;         
end;         
s := 'A2:f'+ IntToStr(k+2);         
Excelid.worksheets.Range.Font.Name := '宋体';         
Excelid.worksheets.Range.Font.size := 9;         
Excelid.worksheets.Range.Borders.LineStyle := 1;         
Excelid.Quit;         
except      
Application.MessageBox('导入数据出错！请检查文件的格式是否正确！', '提示信息',
MB_OK+MB_ICONASTERISK+MB_DEFBUTTON1+MB_APPLMODAL);   
end;   
MessageBox(GetActiveWindow(), 'EXCEL数据导出成功!', '提示信息',
MB_OK +MB_ICONWARNING);
end;</pre>
<div class="cnblogs_code_toolbar"><span class="cnblogs_code_copy"><img src="https://assets.cnblogs.com/images/copycode.gif"></span></div>
</div>
<p>三; delphi导出EXCEL</p>
<div class="cnblogs_code">
<div class="cnblogs_code_toolbar"><span class="cnblogs_code_copy"><img src="https://assets.cnblogs.com/images/copycode.gif"></span></div>
<pre>uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, Mask, ComCtrls, StdCtrls, Buttons, Grids, ValEdit, IdBaseComponent,
CheckLst, excel97, ExcelXP, OleServer, ComObj, excel2000, mmsystem, ShellAPI,
ADODB, DB, DBGrids, clipbrd;
Var
FExcel:OleVariant; //excel应用程序FWorkBook :OleVariant; //工作表Temsheet:OleVariant; //工作薄FPicture:OleVariant;//图片tmpstr:String;
range:variant;//范围i,j,TemInt:integer;
TemFileName:String;
begin
SaveDialog1.Filter:='.xls';
if SaveDialog1.Execute then
begin
    TemFileName:=SaveDialog1.FileName+'.xls';
   
    Screen.Cursor:=CrHourGlass;
    TemInt:=0;
    FExcel:= CreateoleObject('excel.Application');
    FWorkBook:=FExcel.WorkBooks.Add(-4167); //新的工作表    Temsheet:=FWorkBook.Worksheets.Add;
    Temsheet.Name:='利润统计';
    Temsheet.Select;
    Temsheet.Columns.ColumnWidth:=4;//设置列宽度    Temsheet.Columns.ColumnWidth:=10;
    Temsheet.Columns.ColumnWidth:=16;
    Temsheet.Columns.ColumnWidth:=10;
    Temsheet.Columns.ColumnWidth:=10;
    Temsheet.Columns.ColumnWidth:=10;
    Temsheet.Columns.ColumnWidth:=10;
    Temsheet.Columns.ColumnWidth:=10;
    Temsheet.Columns.ColumnWidth:=20;
    Temsheet.Columns.ColumnWidth:=15;
    range:=Temsheet.Range,Temsheet.cells];//选定表格    range.select;
    range.merge; //合并单元格    tmpstr:=ExtractFilePath(ParamStr(0))+'tem.jpg';   //添加图片    FPicture:=Temsheet.Pictures.Insert(tmpstr);
    FPicture.Left:=20;
    FPicture.Top:=5;
    FPicture.width:=50;
    FPicture.height:=50;
    FPicture:=null;
    range:=Temsheet.Range,Temsheet.cells];//选定表格    range.select;
    range.merge;
    Range.Characters.Font.FontStyle :='加粗';
    Temsheet.Cells.HorizontalAlignment:=-4108; //字居中    Temsheet.Cells:=ComSName;
    range:=Temsheet.Range,Temsheet.cells];//选定表格    range.select;
    range.merge;
    Temsheet.Cells.HorizontalAlignment:=-4108; //字居中    Temsheet.Cells:=ComEName;
    range:=Temsheet.Range,Temsheet.cells];//选定表格    range.select;
    range.merge;
    Temsheet.Cells.HorizontalAlignment:=-4108; //字居中    Temsheet.Cells:=ComName;
    Temsheet.Cells:='联系人：';
    Temsheet.Cells:='电话：';
    Temsheet.Cells:=ComPhone;
    Temsheet.Cells:='传真：';
    Temsheet.Cells:=ComFax;
    range:=Temsheet.Range,Temsheet.cells];//选定表格    range.select;
    range.merge;
    range:=Temsheet.Range,Temsheet.cells];//选定表格    range.select;
    range.merge;
    Range.Characters.Font.FontStyle :='加粗';
    Temsheet.Cells:='入库信息：';
    range:=Temsheet.Range,Temsheet.cells];//选定表格    range.select;
    range.merge;
    Temsheet.Cells:='序号';
    Temsheet.Cells.HorizontalAlignment:=-4108; //字居中    Temsheet.Cells.Interior.Color:=clGray;   //单元格背景色    range:=Temsheet.Range,Temsheet.cells];//选定表格    range.borders.linestyle:=1;//华线    for i:=0 to DBGrid1.Columns.Count - 1 do
    begin
      Temsheet.Cells:=DBGrid1.Columns.Title.Caption;
      Temsheet.Cells.HorizontalAlignment:=-4108; //字居中      Temsheet.Cells.Interior.Color:=clGray;   //单元格背景色      range:=Temsheet.Range,Temsheet.cells];//选定表格      range.borders.linestyle:=1;//华线    end;
    //////////////////////////////////////////////
    j:=0;
    DBGrid1.DataSource.DataSet.First;
    while not DBGrid1.DataSource.DataSet.Eof do
    begin
      Temsheet.Cells.Value:=j+1;
      Temsheet.Cells.HorizontalAlignment:=-4108; //字居中      range:=Temsheet.Range,Temsheet.cells];//选定表格      range.borders.linestyle:=1;//华线      for i:=0 to DBGrid1.Columns.Count - 1 do
      begin
      Temsheet.Cells.Value:=DBGrid1.Fields.AsString;
      range:=Temsheet.Range,Temsheet.cells];//选定表格      range.borders.linestyle:=1;//华线      end;
      DBGrid1.DataSource.DataSet.Next;
      j:=j+1;
    end;
    TemInt:=9+ DBGrid1.DataSource.DataSet.RecordCount;
    range:=Temsheet.Range,Temsheet.cells];//选定表格    range.select;
    range.merge;
    TemInt:=TemInt+1;
    range:=Temsheet.Range,Temsheet.cells];//选定表格    range.select;
    range.merge;
    Range.Characters.Font.FontStyle :='加粗';
    Temsheet.Cells:='出库信息：';
   
    range:=Temsheet.Range,Temsheet.cells];//选定表格    range.select;
    range.merge;
    TemInt:=TemInt+1;
    Temsheet.Cells:='序号';
    Temsheet.Cells.HorizontalAlignment:=-4108; //字居中    Temsheet.Cells.Interior.Color:=clGray;   //单元格背景色    range:=Temsheet.Range,Temsheet.cells];//选定表格    range.borders.linestyle:=1;//华线    for i:=0 to DBGrid2.Columns.Count - 1 do
    begin
      Temsheet.Cells:=DBGrid2.Columns.Title.Caption;
      Temsheet.Cells.HorizontalAlignment:=-4108; //字居中      Temsheet.Cells.Interior.Color:=clGray;   //单元格背景色      range:=Temsheet.Range,Temsheet.cells];//选定表格      range.borders.linestyle:=1;//华线    end;
    TemInt:=TemInt+1;
    //////////////////////////////////////////////
    j:=0;
    DBGrid2.DataSource.DataSet.First;
    while not DBGrid2.DataSource.DataSet.Eof do
    begin
      Temsheet.Cells.Value:=j+1;
      Temsheet.Cells.HorizontalAlignment:=-4108; //字居中      range:=Temsheet.Range,Temsheet.cells];//选定表格      range.borders.linestyle:=1;//华线      for i:=0 to DBGrid2.Columns.Count - 1 do
      begin
      Temsheet.Cells.Value:=DBGrid2.Fields.AsString;
      range:=Temsheet.Range,Temsheet.cells];//选定表格      range.borders.linestyle:=1;//华线      end;
      DBGrid2.DataSource.DataSet.Next;
      j:=j+1;
    end;
    TemInt:=TemInt+ DBGrid2.DataSource.DataSet.RecordCount;
    TemInt:=TemInt+1;
   
    range:=Temsheet.Range,Temsheet.cells];//选定表格    range.select;
    range.merge;
    TemInt:=TemInt+1;
    range:=Temsheet.Range,Temsheet.cells];//选定表格    range.select;
    range.merge;
    Range.Characters.Font.FontStyle :='加粗';
    Temsheet.Cells:='入库总额：';
    Temsheet.Cells:=Trim(Edit1.Text);
    range:=Temsheet.Range,Temsheet.cells];//选定表格    range.select;
    range.merge;
    TemInt:=TemInt+1;
    range:=Temsheet.Range,Temsheet.cells];//选定表格    range.select;
    range.merge;
    Range.Characters.Font.FontStyle :='加粗';
    Temsheet.Cells:='出库总额：';
    Temsheet.Cells:=Trim(Edit2.Text);
    range:=Temsheet.Range,Temsheet.cells];//选定表格    range.select;
    range.merge;
    TemInt:=TemInt+1;
    range:=Temsheet.Range,Temsheet.cells];//选定表格    range.select;
    range.merge;
    Range.Characters.Font.FontStyle :='加粗';
    Temsheet.Cells:='总利润：';
    Temsheet.Cells:=Trim(Edit3.Text);
    range:=Temsheet.Range,Temsheet.cells];//选定表格    range.select;
    range.merge;
   
    range:=Temsheet.Range,Temsheet.cells];//选定表格    range.borders.linestyle:=1;//华线    Application.ProcessMessages;
    Screen.Cursor:=CrDefault;
    FExcel.WorkBooks.saveas(TemFileName);//保存文件    FExcel.workbooks.close; //关闭工作表    Application.ProcessMessages;
    MessageBox(Handle,'导出成功','提示',MB_OK);
    //FExcel.visible:=true;
    FExcel.quit; //关闭Excel
    FExcel := unassigned;
    shellexecute(0,'open',PChar(ExtractFileName(TemFileName)),nil,PChar(ExtractFilePath(TemFileName)),SW_Show);

end;
end;</pre>
<div class="cnblogs_code_toolbar"><span class="cnblogs_code_copy"><img src="https://assets.cnblogs.com/images/copycode.gif"></span></div>
</div>
<p>四;</p>
<div class="cnblogs_code">
<div class="cnblogs_code_toolbar"><span class="cnblogs_code_copy"><img src="https://assets.cnblogs.com/images/copycode.gif"></span></div>
<pre>uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, Mask, ComCtrls, StdCtrls, Buttons, Grids, ValEdit, IdBaseComponent,
CheckLst, excel97, ExcelXP, OleServer, comobj, excel2000, mmsystem,
ADODB, DB, DBGrids, clipbrd;四;
procedure TFIND_FM.Button1Click(Sender: TObject);
var
i,j : integer;
reportname, wpath : string;
ExApp1 : TExcelApplication;
ExWrbk1 : TExcelWorkbook;
ExWrst1 : TExcelWorksheet;
begin

if Main_FM.ADOQuery_TEMP.IsEmpty then
    begin
    Showmessage('沒有可導出的資料!');
    Exit;
    end
else
    begin
    Main_FM.SaveDialog1.FileName := 'qcreport';
    ifMain_FM.savedialog1.Execute then
      begin
      //savedialog1.FileName := formatdatetime('YYYYMMDDHHMMSS',now())+'md_orderqc_list.xls';
      reportname :=formatdatetime('YYYYMMDDHHMMSS',now())+ExtractFileName(Main_FM.savedialog1.FileName);
      //reportname :=formatdatetime('YYYYMMDDHHMMSS',now())+'';
      wpath := ExtractFilePath(Main_FM.savedialog1.FileName);
      //showmessage(wpath);
      try
          ExApp1 := TExcelApplication.Create(application);
          ExWrbk1 := TExcelWorkbook.Create(application);
          ExWrst1 := TExcelWorksheet.Create(application);
          ExApp1.Connect;
      except
          Showmessage('電腦沒裝Excel!無法導出!');
          Abort;
      end;
      try
          try
          ExApp1.Workbooks.Add(EmptyParam,0);
          ExWrbk1.ConnectTo(ExApp1.Workbooks);
          ExWrst1.ConnectTo(ExWrbk1.Worksheets as _worksheet);
          Main_FM.ADOQuery_TEMP.First;
          for j := 0 to Main_FM.ADOQuery_TEMP.FieldCount-1 do
            begin
            ExWrst1.Cells.Item := Main_FM.ADOQuery_TEMP.Fields.DisplayName;
            //
            end;
          for i := 2 to Main_FM.ADOQuery_TEMP.RecordCount+1 do
            begin
            for j := 0 to Main_FM.ADOQuery_TEMP.FieldCount-1 do
                begin
                ExWrst1.Cells.Item := Main_FM.ADOQuery_TEMP.Fields.Value;
                end;
            Main_FM.ADOQuery_TEMP.Next;
            end;
          ExWrst1.SaveAs(wpath+reportname);
          //ExWrst.SaveAs(formatdatetime('YYYYMMDDHHMMSS',now())+reportname);;
          Showmessage('數據已成功導出!');
          except
          Showmessage('導出失敗!');
          abort;
          end;
      finally
          ExApp1.Disconnect;
          ExApp1.Quit;
          ExApp1.Free;
          ExWrbk1.Free;
          ExWrst1.Free;
      end;
      end;
    end;
end;</pre>
<div class="cnblogs_code_toolbar"><span class="cnblogs_code_copy"><img src="https://assets.cnblogs.com/images/copycode.gif"></span></div>
</div>
<p>delphi导出数据至Excel的三种方法及比较闲来无事，跑到网上搜集了几种导出DataSet至Excel的几种方法。另外使用GetTickcount函数计算时差，以便比较。（本来使用Timer控件，但是Timer不适合做高精度时间计算）使用TADOConnect，TADOQuery查询数据。方法五：&nbsp;&nbsp; 使用TADOQuery + Varaint方法，循环遍历数据集中数据，直接插入到Excel的WookBook单元。这是初学者最易懂和易接受的方法。在下面代码中没有仔细注意语法（比如没有使用try..finally结构体），如果需要使用，请注意：//使用ADO循环方式保存。</p>
<div class="cnblogs_code">
<div class="cnblogs_code_toolbar"><span class="cnblogs_code_copy"><img src="https://assets.cnblogs.com/images/copycode.gif"></span></div>
<pre>procedure TForm1.btn_WhileClick(Sender: TObject);
var
   Eclapp:variant;
   n:integer;
   filename: string;
   t1,t2: Int64;
begin
   Eclapp := CreateOleObject('Excel.Application');
   Eclapp.WorkBooks.Add;
   Eclapp.Visible:= False;
   filename :='d:\数据1.xls';
   lbl2.Caption := '0';
   if FileExists(fileName) then
   DeleteFile(fileName);
   t1:= GetTickCount;
   qry1.DisableControls;
   qry1.First;
   n:=2;
   while not qry1.Eof do
   begin
   eclapp.cells := qry1.Fields.AsString;
   eclapp.cells := qry1.Fields.AsString;
   eclapp.cells := qry1.Fields.AsString;
   eclapp.cells := qry1.Fields.AsString;
   //为了简单，只添加了4个栏位   inc(n);
   qry1.Next;
   application.ProcessMessages;
   end;
   qry1.EnableControls;
   t2:= GetTickCount;
   eclapp.visible := false;
   eclapp.Workbooks.SaveAs(filename);
   Eclapp.Quit;
   Eclapp:= Unassigned;
   lbl2.Caption := IntToStr(t2 - t1);
end;</pre>
<div class="cnblogs_code_toolbar"><span class="cnblogs_code_copy"><img src="https://assets.cnblogs.com/images/copycode.gif"></span></div>
</div>
<p>方法六：使用OLE方法导入。&nbsp;&nbsp; 先讲TDateSet中的数据保存为二维OLEVariant数组中，再保存到Excel &nbsp;Sheet中&nbsp; ///使用OLE方式保存。</p>
<div class="cnblogs_code">
<div class="cnblogs_code_toolbar"><span class="cnblogs_code_copy"><img src="https://assets.cnblogs.com/images/copycode.gif"></span></div>
<pre>procedure
TForm1.btn_OleVariantClick(Sender: TObject);
var
fileName: string;
xlApp, Sheet: OleVariant;
rowCount, Colcount, index: Integer;
t1,t2: Int64;
function RefToCell(RowID, ColID: Integer): string;
var
    ACount, APos: Integer;
begin
    ACount := ColID div 26;
    APos := ColID mod 26;
    if APos = 0 then
    begin
      ACount := ACount - 1;
      APos := 26;
    end;
    if ACount = 0 then
      Result := Chr(Ord('A') + ColID - 1) + IntToStr(RowID);
    if ACount = 1 then
      Result := 'A' + Chr(Ord('A') + APos - 1) + IntToStr(RowID);
    if ACount &gt; 1 then
      Result := Chr(Ord('A') + ACount - 1) + Chr(Ord('A') + APos - 1) + IntToStr(RowID);
end;
function getData(ds: TDataSet): OleVariant;
var
    Data: OLEVariant;
    i,j : Integer;
begin
    rowCount := ds.RecordCount;
    colCount := ds.FieldCount;
    Data := VarArrayCreate(, varVariant); //1，rowCount
表示第一维数组的上下标，1，colCount表示第二维数组的上下标    i := 1;
    for j := 0 to colCount - 1 do
    begin
      if not ds.Fields.Visible then
      continue;
      Data := ds.Fields.DisplayLabel;
    end;
    Inc(i);
    ds.DisableControls;
    try
      ds.First;
      while not ds.Eof do
      begin
      for j := 0 to colCount - 1 do
      begin
          Data := ds.Fields.AsString;
      end;
      Inc(i);
      ds.Next;
      Application.ProcessMessages;
      end;
    finally
      ds.EnableControls;
    end;
    result := Data;
end;
begin
fileName := 'd:\数据.xls';
lbl1.Caption := '0';
t1:= GetTickCount;//开始计时if FileExists(fileName) then
    DeleteFile(fileName);
xlApp := CreateOleObject('Excel.Application');
try
    XLApp.Visible := False;
    XLApp.DisplayAlerts := False;
    XLApp.Workbooks.Add;
    // 删除多余的 worksheet
    for index := XLApp.SheetsInNewWorkbook downto 2 do
    begin
      XLApp.Workbooks.Worksheets.Delete;
    end;
    Sheet := XLApp.Workbooks.Worksheets;
    index := 1;
    if index &lt;&gt; 0 then
      Sheet := XLApp.Workbooks.Worksheets.Add;
    Sheet.Name := qry1.Name;
    //Sheet.Columns.NumberFormatLocal := '@'; //设置单元格式为文本    Sheet.Range.Value := getData(qry1);
    XLApp.Workbooks.SaveAs(fileName);
finally
    if not VarIsEmpty(XLApp) then
    begin
      XLApp.Quit;
      XLAPP := Unassigned;
      Sheet := Unassigned;
      application.ProcessMessages;
      t2:= GetTickCount;
      lbl1.Caption := IntToStr( t2 - t1);
    end;
end;
end;</pre>
<div class="cnblogs_code_toolbar"><span class="cnblogs_code_copy"><img src="https://assets.cnblogs.com/images/copycode.gif"></span></div>
</div>
<p>方法七：现在最流行的文件流方法</p>
<div class="cnblogs_code">
<div class="cnblogs_code_toolbar"><span class="cnblogs_code_copy"><img src="https://assets.cnblogs.com/images/copycode.gif"></span></div>
<pre>.....
var
Form1: TForm1;
arXlsBegin: array of Word = ($809, 8, 0, $10, 0, 0);
arXlsEnd: array of Word = ($0A, 00);
arXlsString: array of Word = ($204, 0, 0, 0, 0, 0);
arXlsNumber: array of Word = ($203, 14, 0, 0, 0);
arXlsInteger: array of Word = ($27E, 10, 0, 0, 0);
arXlsBlank: array of Word = ($201, 6, 0, 0, $17);
Procedure ExportExcelFile(FileName: string; bWriteTitle: Boolean; aDataSet: TDataSet);
implementation
{$R *.dfm}
//使用文件流procedure incColRow; //增加行列号begin
    if Col = ADataSet.FieldCount - 1 then
      begin
      Inc(Row);
      Col :=0;
      end
    else
      Inc(Col);
end;
procedure WriteStringCell(AValue: string);//写字符串数据var
L: Word;
begin
   L := Length(AValue);
   arXlsString := 8 + L;
   arXlsString := Row;
   arXlsString := Col;
   arXlsString := L;
   aFileStream.WriteBuffer(arXlsString, SizeOf (arXlsString));
   aFileStream.WriteBuffer(Pointer(AValue)^, L);
   IncColRow;
end;
procedure WriteIntegerCell(AValue: integer);//写整数var
    V: Integer;
begin
    arXlsInteger := Row;
    arXlsInteger := Col;
    aFileStream.WriteBuffer(arXlsInteger, SizeOf(arXlsInteger));
    V := (AValue shl 2) or 2;
    aFileStream.WriteBuffer(V, 4);
    IncColRow;
end;
procedure WriteFloatCell(AValue: double );//写浮点数begin
   arXlsNumber := Row;
   arXlsNumber := Col;
   aFileStream.WriteBuffer(arXlsNumber, SizeOf(arXlsNumber));
   aFileStream.WriteBuffer(AValue, 8);
   IncColRow;
end;
Procedure ExportExcelFile(FileName: string; bWriteTitle: Boolean; aDataSet: TDataSet);
var
i,j: integer;
Col , row: word;
ABookMark: TBookMark;
aFileStream: TFileStream;
//......
//......
begin
   if FileExists(FileName) then DeleteFile(FileName); //文件存在，先删除      aFileStream := TFileStream.Create(FileName, fmCreate);
   Try    //写文件头　      aFileStream.WriteBuffer(arXlsBegin, SizeOf(arXlsBegin));   //写列头
　      Col := 0; Row := 0;
      if bWriteTitle then
      begin
      for i := 0 to aDataSet.FieldCount - 1 do
          WriteStringCell(aDataSet.Fields.FieldName);
      end;       //写数据集中的数据
　　      aDataSet.DisableControls;
      //ABookMark := aDataSet.GetBookmark;
      aDataSet.First ;
      while not aDataSet.Eof do
      begin
      for i := 0 to aDataSet.FieldCount - 1 do
      case ADataSet.Fields.DataType of
            ftSmallint, ftInteger, ftWord, ftAutoInc, ftBytes:
            WriteIntegerCell(aDataSet.Fields.AsInteger);
            ftFloat, ftCurrency, ftBCD:
            WriteFloatCell(aDataSet.Fields.AsFloat)
      else
            WriteStringCell(aDataSet.Fields.AsString);
      end;
      aDataSet.Next;
      Application.ProcessMessages;
      end;
      //写文件尾
　      AFileStream.WriteBuffer(arXlsEnd, SizeOf(arXlsEnd));
      //if ADataSet.BookmarkValid(ABookMark) then aDataSet.GotoBookmark(ABookMark);
   Finally
   AFileStream.Free;
   ADataSet.EnableControls;
   end;
end;
//调用：procedure TForm1.btn_FileStreamClick(Sender: TObject);
var
t1,t2: Int64;
begin
lbl3.Caption := '0';
t1:= GetTickCount;
ExportExcelFile('d:\数据2.xls',true,qry1);
t2:= GetTickCount;
lbl3.Caption:= IntToStr(t2 - t1);
end;</pre>
<div class="cnblogs_code_toolbar"><span class="cnblogs_code_copy"><img src="https://assets.cnblogs.com/images/copycode.gif"></span></div>
</div>
</div>
</div>
</div>

</div>
<div id="MySignature" role="contentinfo">
    <div id="AllanboltSignature">            <div>作者：沧江魅影</div>      <div>出处：https://www.cnblogs.com/ynmsnc/</div>      <div>本文版权归作者和博客园共有，欢迎转载，但未经作者同意必须保留此段声明，且在文章页面明显位置给出原文连接，否则保留追究法律责任的权利.</div>      </div><br><br>
来源：https://www.cnblogs.com/ynmsnc/p/18343172

查看完整版本: delphi 导出到excel的7种方法