delphi 导出到excel的7种方法

转载 2013年12月02日 09:09:57

第一种方法delphi 快速导出excel
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[1];
    tsList:=TStringList.Create;
    //tsList.Add('
查询结果');   //加入标题

    s:='';   //
加入字段名
    for y := 0 to adoquery.fieldCount - 1 do
    begin
       s:=s+adoQuery.Fields.Fields[y].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[y].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)<>'.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;
调用
:
        ToExcel('D:\a.xsl',QueryToExcel);//
路径可以自定义

-------------------------------------------------------------------------------------------------
*************************************************************************************************
;
delphi
如何导出EXCEL,代码。非第3方控件

首先在Uses处加上ComObj
procedure TForm1.Button1Click(Sender: TObject); 
var  h,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[1].range['A1:c1'].Merge(True);         
Excelid.WorkSheets[1].Cells[1,1].Value :='
部门编码表
' ;         
Excelid.worksheets[1].Range['a1:a1'].HorizontalAlignment := $FFFFEFF4;         
Excelid.worksheets[1].Range['a1:a1'].VerticalAlignment := $FFFFEFF4;         
Excelid.WorkSheets[1].Cells[2,1].Value := '
组别编号
';         
Excelid.WorkSheets[1].Cells[2,2].Value := '
公司编号
';         
Excelid.WorkSheets[1].Cells[2,3].Value := '
组别名称
';         
Excelid.worksheets[1].Range['A1:c1'].Font.Name := '
宋体
';         
Excelid.worksheets[1].Range['A1:c1'].Font.Size := 9;         
Excelid.worksheets[1].range['A1:c2'].font.bold:=true;         
Excelid.worksheets[1].Range['A2:c2'].Font.Size := 9;         
Excelid.worksheets[1].Range['A2:c2'].HorizontalAlignment := $FFFFEFF4;         
Excelid.worksheets[1].Range['A2:c2'].VerticalAlignment := $FFFFEFF4;         
h:=3;         
ADOQuery1.First;        
while not ADOQuery1.Eof do         
begin           Excelid.WorkSheets[1].Cells[h,1].Value := Adoquery1.FieldByName('Fdept_id').AsString;           
Excelid.WorkSheets[1].Cells[h,2].Value := Adoquery1.FieldByName('Ffdept_id').AsString;           
Excelid.WorkSheets[1].Cells[h,3].Value := Adoquery1.FieldByName('Fdept_name').AsString;           
Inc(h);            
Adoquery1.Next;         
end;         
s := 'A2:f'+ IntToStr(k+2);         
Excelid.worksheets[1].Range[s].Font.Name := '
宋体
';         
Excelid.worksheets[1].Range[s].Font.size := 9;         
Excelid.worksheets[1].Range[s].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;
 
-----------------------------------------------------------------------------------------------------------------------------------------------
****************************************************************************************************************************************
;
delphi
导出
EXCEL
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[1].ColumnWidth:=4;//
设置列宽度

    Temsheet.Columns[2].ColumnWidth:=10;
    Temsheet.Columns[3].ColumnWidth:=16;
    Temsheet.Columns[4].ColumnWidth:=10;
    Temsheet.Columns[5].ColumnWidth:=10;
    Temsheet.Columns[6].ColumnWidth:=10;
    Temsheet.Columns[7].ColumnWidth:=10;
    Temsheet.Columns[8].ColumnWidth:=10;
    Temsheet.Columns[9].ColumnWidth:=20;
    Temsheet.Columns[10].ColumnWidth:=15;
    range:=Temsheet.Range[Temsheet.cells[1,1],Temsheet.cells[5,2]];//
选定表格
    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[2,3],Temsheet.cells[3,4]];//
选定表格
    range.select;
    range.merge;
    Range.Characters.Font.FontStyle :='
加粗';
    Temsheet.Cells[2,3].HorizontalAlignment:=-4108; //
字居中

    Temsheet.Cells[2,3]:=ComSName;
    range:=Temsheet.Range[Temsheet.cells[4,3],Temsheet.cells[4,4]];//
选定表格
    range.select;
    range.merge;
    Temsheet.Cells[4,3].HorizontalAlignment:=-4108; //
字居中
    Temsheet.Cells[4,3]:=ComEName;
    range:=Temsheet.Range[Temsheet.cells[2,5],Temsheet.cells[2,6]];//
选定表格
    range.select;
    range.merge;
    Temsheet.Cells[2,5].HorizontalAlignment:=-4108; //
字居中
    Temsheet.Cells[2,5]:=ComName;
    Temsheet.Cells[3,5]:='
联系人:';
    Temsheet.Cells[4,5]:='
电话:
';
    Temsheet.Cells[4,6]:=ComPhone;
    Temsheet.Cells[5,5]:='
传真:
';
    Temsheet.Cells[5,6]:=ComFax;
    range:=Temsheet.Range[Temsheet.cells[6,1],Temsheet.cells[6,10]];//
选定表格

    range.select;
    range.merge;
    range:=Temsheet.Range[Temsheet.cells[7,1],Temsheet.cells[7,2]];//
选定表格
    range.select;
    range.merge;
    Range.Characters.Font.FontStyle :='
加粗';
    Temsheet.Cells[7,1]:='
入库信息:
';
    range:=Temsheet.Range[Temsheet.cells[7,3],Temsheet.cells[7,10]];//
选定表格

    range.select;
    range.merge;
    Temsheet.Cells[8,1]:='
序号';
    Temsheet.Cells[8,1].HorizontalAlignment:=-4108; //
字居中

    Temsheet.Cells[8,1].Interior.Color:=clGray;     //
单元格背景色
    range:=Temsheet.Range[Temsheet.cells[8,1],Temsheet.cells[8,1]];//
选定表格
    range.borders.linestyle:=1;//
华线
    for i:=0 to DBGrid1.Columns.Count - 1 do
    begin
      Temsheet.Cells[8,i+2]:=DBGrid1.Columns[i].Title.Caption;
      Temsheet.Cells[8,i+2].HorizontalAlignment:=-4108; //
字居中
      Temsheet.Cells[8,i+2].Interior.Color:=clGray;     //
单元格背景色
      range:=Temsheet.Range[Temsheet.cells[8,i+2],Temsheet.cells[8,i+2]];//
选定表格
      range.borders.linestyle:=1;//
华线
    end;
    //////////////////////////////////////////////
    j:=0;
    DBGrid1.DataSource.DataSet.First;
    while not DBGrid1.DataSource.DataSet.Eof do
    begin
      Temsheet.Cells[9+j,1].Value:=j+1;
      Temsheet.Cells[9+j,1].HorizontalAlignment:=-4108; //
字居中
      range:=Temsheet.Range[Temsheet.cells[9+j,1],Temsheet.cells[9+j,1]];//
选定表格
      range.borders.linestyle:=1;//
华线
      for i:=0 to DBGrid1.Columns.Count - 1 do
      begin
        Temsheet.Cells[9+j,i+2].Value:=DBGrid1.Fields[i].AsString;
        range:=Temsheet.Range[Temsheet.cells[9+j,i+2],Temsheet.cells[9+j,i+2]];//
选定表格
        range.borders.linestyle:=1;//
华线
      end;
      DBGrid1.DataSource.DataSet.Next;
      j:=j+1;
    end;
    TemInt:=9+ DBGrid1.DataSource.DataSet.RecordCount;
    range:=Temsheet.Range[Temsheet.cells[TemInt,1],Temsheet.cells[TemInt,10]];//
选定表格
    range.select;
    range.merge;
    TemInt:=TemInt+1;
    range:=Temsheet.Range[Temsheet.cells[TemInt,1],Temsheet.cells[TemInt,2]];//
选定表格
    range.select;
    range.merge;
    Range.Characters.Font.FontStyle :='
加粗';
    Temsheet.Cells[TemInt,1]:='
出库信息:
';
   
    range:=Temsheet.Range[Temsheet.cells[TemInt,3],Temsheet.cells[TemInt,10]];//
选定表格

    range.select;
    range.merge;
    TemInt:=TemInt+1;
    Temsheet.Cells[TemInt,1]:='
序号';
    Temsheet.Cells[TemInt,1].HorizontalAlignment:=-4108; //
字居中

    Temsheet.Cells[TemInt,1].Interior.Color:=clGray;     //
单元格背景色
    range:=Temsheet.Range[Temsheet.cells[TemInt,1],Temsheet.cells[TemInt,1]];//
选定表格
    range.borders.linestyle:=1;//
华线
    for i:=0 to DBGrid2.Columns.Count - 1 do
    begin
      Temsheet.Cells[TemInt,i+2]:=DBGrid2.Columns[i].Title.Caption;
      Temsheet.Cells[TemInt,i+2].HorizontalAlignment:=-4108; //
字居中
      Temsheet.Cells[TemInt,i+2].Interior.Color:=clGray;     //
单元格背景色
      range:=Temsheet.Range[Temsheet.cells[TemInt,i+2],Temsheet.cells[TemInt,i+2]];//
选定表格
      range.borders.linestyle:=1;//
华线
    end;
    TemInt:=TemInt+1;
    //////////////////////////////////////////////
    j:=0;
    DBGrid2.DataSource.DataSet.First;
    while not DBGrid2.DataSource.DataSet.Eof do
    begin
      Temsheet.Cells[TemInt+j,1].Value:=j+1;
      Temsheet.Cells[TemInt+j,1].HorizontalAlignment:=-4108; //
字居中
      range:=Temsheet.Range[Temsheet.cells[TemInt+j,1],Temsheet.cells[TemInt+j,1]];//
选定表格
      range.borders.linestyle:=1;//
华线
      for i:=0 to DBGrid2.Columns.Count - 1 do
      begin
        Temsheet.Cells[TemInt+j,i+2].Value:=DBGrid2.Fields[i].AsString;
        range:=Temsheet.Range[Temsheet.cells[TemInt+j,i+2],Temsheet.cells[TemInt+j,i+2]];//
选定表格
        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[TemInt,1],Temsheet.cells[TemInt,10]];//
选定表格
    range.select;
    range.merge;
    TemInt:=TemInt+1;
    range:=Temsheet.Range[Temsheet.cells[TemInt,1],Temsheet.cells[TemInt,2]];//
选定表格
    range.select;
    range.merge;
    Range.Characters.Font.FontStyle :='
加粗';
    Temsheet.Cells[TemInt,1]:='
入库总额:
';
    Temsheet.Cells[TemInt,3]:=Trim(Edit1.Text);
    range:=Temsheet.Range[Temsheet.cells[TemInt,4],Temsheet.cells[TemInt,10]];//
选定表格

    range.select;
    range.merge;
    TemInt:=TemInt+1;
    range:=Temsheet.Range[Temsheet.cells[TemInt,1],Temsheet.cells[TemInt,2]];//
选定表格
    range.select;
    range.merge;
    Range.Characters.Font.FontStyle :='
加粗';
    Temsheet.Cells[TemInt,1]:='
出库总额:
';
    Temsheet.Cells[TemInt,3]:=Trim(Edit2.Text);
    range:=Temsheet.Range[Temsheet.cells[TemInt,4],Temsheet.cells[TemInt,10]];//
选定表格

    range.select;
    range.merge;
    TemInt:=TemInt+1;
    range:=Temsheet.Range[Temsheet.cells[TemInt,1],Temsheet.cells[TemInt,2]];//
选定表格
    range.select;
    range.merge;
    Range.Characters.Font.FontStyle :='
加粗';
    Temsheet.Cells[TemInt,1]:='
总利润:
';
    Temsheet.Cells[TemInt,3]:=Trim(Edit3.Text);
    range:=Temsheet.Range[Temsheet.cells[TemInt,4],Temsheet.cells[TemInt,10]];//
选定表格

    range.select;
    range.merge;
   
    range:=Temsheet.Range[Temsheet.cells[7,1],Temsheet.cells[TemInt,10]];//
选定表格
    range.borders.linestyle:=1;//
华线
    Application.ProcessMessages;
    Screen.Cursor:=CrDefault;
    FExcel.WorkBooks[1].saveas(TemFileName);//
保存文件
    FExcel.workbooks[1].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;
--------------------------------------------------------------------------------------------------------------------
********************************************************************************************************************
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';
    if  Main_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[1]);
          ExWrst1.ConnectTo(ExWrbk1.Worksheets[1] as _worksheet);
          Main_FM.ADOQuery_TEMP.First;
          for j := 0 to Main_FM.ADOQuery_TEMP.FieldCount-1 do
            begin
            ExWrst1.Cells.Item[1,j+1] := Main_FM.ADOQuery_TEMP.Fields[j].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[i,j+1] := Main_FM.ADOQuery_TEMP.Fields[j].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;
--------------------------------------------------------------------------------------------------
**************************************************************************************************
delphi
导出数据至Excel的三种方法及比较

闲来无事,跑到网上搜集了几种导出DataSetExcel的几种方法。另外使用GetTickcount函数计算时差,以便比较。(本来使用Timer控件,但是Timer不适合做高精度时间计算)
使用TADOConnectTADOQuery查询数据。
方法五:
  
使用TADOQuery + Varaint方法,循环遍历数据集中数据,直接插入到ExcelWookBook单元。这是初学者最易懂和易接受的方法。
在下面代码中没有仔细注意语法(比如没有使用try..finally结构体),如果需要使用,请注意:
//
使用ADO循环方式保存
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[n,1] := qry1.Fields[0].AsString;
     eclapp.cells[n,2] := qry1.Fields[1].AsString;
     eclapp.cells[n,3] := qry1.Fields[2].AsString;
     eclapp.cells[n,4] := qry1.Fields[3].AsString;
     //
为了简单,只添加了4个栏位

     inc(n);
     qry1.Next;
     application.ProcessMessages;
   end;
   qry1.EnableControls;
   t2:= GetTickCount;
   eclapp.visible := false;
   eclapp.Workbooks[1].SaveAs(filename);
   Eclapp.Quit;
   Eclapp:= Unassigned;
   lbl2.Caption := IntToStr(t2 - t1);
end;
---------------------------------------------------------------------------------------------------------
*********************************************************************************************************
方法六:使用OLE方法导入。
  
先讲TDateSet中的数据保存为二维OLEVariant数组中,再保存到Excel Sheet  ///使用OLE方式保存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 > 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([1, rowCount + 1, 1, colCount], varVariant); //1
rowCount 表示第一维数组的上下标,1colCount表示第二维数组的上下标

    i := 1;
    for j := 0 to colCount - 1 do
    begin
      if not ds.Fields[j].Visible then
        continue;
      Data[i,j + 1] := ds.Fields[j].DisplayLabel;
    end;
    Inc(i);
    ds.DisableControls;
    try
      ds.First;
      while not ds.Eof do
      begin
        for j := 0 to colCount - 1 do
        begin
          Data[i,j + 1] := ds.Fields[j].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[1].Worksheets[index].Delete;
    end;
    Sheet := XLApp.Workbooks[1].Worksheets[1];
    index := 1;
    if index <> 0 then
      Sheet := XLApp.Workbooks[1].Worksheets.Add;
    Sheet.Name := qry1.Name;
    //Sheet.Columns.NumberFormatLocal := '@'; //
设置单元格式为文本

    Sheet.Range[RefToCell(1, 1), RefToCell(rowCount + 1, colCount)].Value := getData(qry1);
    XLApp.Workbooks[1].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;
-------------------------------------------------------------------------------------------------------
*******************************************************************************************************
方法七:现在最流行的文件流方法
.....
var
Form1: TForm1;
arXlsBegin: array[0..5] of Word = ($809, 8, 0, $10, 0, 0);
arXlsEnd: array[0..1] of Word = ($0A, 00);
arXlsString: array[0..5] of Word = ($204, 0, 0, 0, 0, 0);
arXlsNumber: array[0..4] of Word = ($203, 14, 0, 0, 0);
arXlsInteger: array[0..4] of Word = ($27E, 10, 0, 0, 0);
arXlsBlank: array[0..4] 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[1] := 8 + L;
     arXlsString[2] := Row;
     arXlsString[3] := Col;
     arXlsString[5] := L;
     aFileStream.WriteBuffer(arXlsString, SizeOf (arXlsString));
     aFileStream.WriteBuffer(Pointer(AValue)^, L);
     IncColRow;
end;
procedure WriteIntegerCell(AValue: integer);//
写整数
var
    V: Integer;
begin
    arXlsInteger[2] := Row;
    arXlsInteger[3] := Col;
    aFileStream.WriteBuffer(arXlsInteger, SizeOf(arXlsInteger));
    V := (AValue shl 2) or 2;
    aFileStream.WriteBuffer(V, 4);
    IncColRow;
end;
procedure WriteFloatCell(AValue: double );//
写浮点数
begin
     arXlsNumber[2] := Row;
     arXlsNumber[3] := 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[i].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[i].DataType of
              ftSmallint, ftInteger, ftWord, ftAutoInc, ftBytes:
              WriteIntegerCell(aDataSet.Fields[i].AsInteger);
              ftFloat, ftCurrency, ftBCD:
              WriteFloatCell(aDataSet.Fields[i].AsFloat)
        else
              WriteStringCell(aDataSet.Fields[i].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;


Delphi 导出、导入Excel的一个快速方法

The quickest way is to use an array of Variant,and just pass the entire array to Excel: var     xls,...
  • lcfeng1982
  • lcfeng1982
  • 2015年02月13日 11:03
  • 3352

Delphi 导出数据至Excel的7种方法

一; delphi 快速导出excel uses ComObj,clipbrd; function ToExcel(sfilename:string; ADOQuery:TADOQuery):...
  • zang141588761
  • zang141588761
  • 2016年08月22日 13:15
  • 5958

Delphi 导出数据至Excel的7种方法

  • 2016年09月18日 21:17
  • 28KB
  • 下载

delphi 使用把数据集导出为excel文件 (适合安装Excel的机器)

use ComObj ; //==================================== //delphi导出Excel表 procedure saveToExcel(a...
  • ijong
  • ijong
  • 2011年05月16日 19:00
  • 1939

delphi ExcelExport控件(导出到excel)

  • 2010年07月24日 14:59
  • 519KB
  • 下载

delphi表格数据导出到excel的控件

  • 2017年09月13日 08:18
  • 943KB
  • 下载

Delphi快速导出数据到Excel

  • 2008年01月07日 17:30
  • 5KB
  • 下载

delphi 的一个导出excel的方法的类

导出方法 Button procedure TFrm_ClientGameRecord.Act_ExportExecute(Sender: TObject); var ToExcel:TTOExe...
  • easyboot
  • easyboot
  • 2013年01月02日 09:34
  • 645

delphi要控制EXCEL时用的,不错,转了。

定义变量   Excelid:variant;   1、创建OLE对象   try     Excelid:=CreateOleObject( 'Excel.Applic...
  • onebigday
  • onebigday
  • 2016年01月29日 15:29
  • 2706

怎么在delphi中读取Excel数据(各种详细操作)

( 一 ) 使用动态创建的方法 首先创建 Excel 对象,使用ComObj : Var ExcelApp : Variant ; ExcelApp := CreateOleObject ...
  • zisongjia
  • zisongjia
  • 2017年03月15日 15:30
  • 1079
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:delphi 导出到excel的7种方法
举报原因:
原因补充:

(最多只允许输入30个字)