首页 > 其他分享 >delphi 导出到excel的7种方法

delphi 导出到excel的7种方法

时间：2024-08-05 14:39:19浏览次数：14  
标签：end Temsheet excel delphi 导出 Cells TemInt range cells

delphi 导出到excel的7种方法

本文来自 爱好者8888 的CSDN 博客 ，全文地址请点击：https://blog.csdn.net/kpc2000/article/details/17066823?utm_source=copy

===================================================================================================

第一种方法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的三种方法及比较闲来无事，跑到网上搜集了几种导出DataSet至Excel的几种方法。另外使用GetTickcount函数计算时差，以便比较。（本来使用Timer控件，但是Timer不适合做高精度时间计算）使用TADOConnect，TADOQuery查询数据。方法五：   使用TADOQuery + Varaint方法，循环遍历数据集中数据，直接插入到Excel的WookBook单元。这是初学者最易懂和易接受的方法。在下面代码中没有仔细注意语法（比如没有使用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
表示第一维数组的上下标，1，colCount表示第二维数组的上下标    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;
复制代码

标签：end,Temsheet,excel,delphi,导出,Cells,TemInt,range,cells
From： https://www.cnblogs.com/ynmsnc/p/18343172

相关文章

  • Delphi Format 格式化数字
    Format('x=%d',[12]);//'x=12'//最普通Format('x=%3d',[12]);//'x=12'//指定宽度Format('x=%f',[12.0]);//'x=12.00'//浮点数Format('x=%.3f',[12.0]);//'x=12.000'//指定小数Format('x......
  • Delphi 快捷键
    分类快捷键解释备注组件设计类Escape选择当前组件容器 Shift+Click选择多个组件；选择窗体 Tab选择下一个组件 Shift+Tab选择上一个组件 方向键选择此方向的下一个组件 Ctrl+方向键将所选组件的位置移动1个像素 Shift+......
  • Delphi ExtractFilePath
    1、取路径1、取路径。 1.1 ExtractFilePath之类的返回路径。原文链接（https://www.cnblogs.com/ZhouXiHong/archive/2007/01/30/634210.html）ExtractFileDrive：返回完整文件名中的驱动器，如"C:"ExtractFilePath：返回完整文件名中的路径，最后带“/”，如"C:\test\"ExtractFileDir：返......
  • excel函数的学习
    1、学习excelSUM ：求和函数AVERAGE：平均值函数IFROUNDMAXMININTVLOOKUPSUMIFSUMSIFCOUNTCOUNTIFNOWTODAYMIDPHONETICLENRIGHT二、实操（1）SUM ：求和函数 条件判断函数四舍五入函数最大值函数最小值函数数据取整函数条件查找函数按条件求和函数按多个条件求和函数统计数字个......
  • Delphi 线程
    不是原创，只是看到好的内容复制了保存下来，留着学习。 CreadteThred参考，同步参考，WaitForSingleObject参考，互斥参考， 一、在Delphi中使用多线程有两种方法:调用API、使用TThread类;使用API的代码更简单.1、调用API:CreateThread()functionCreateThread( lpThr......
  • 使用python对Excel表格某个区域保存为图片
    实际工作中，我们经常会把表格某个区域（如：A1：F5）或某个图形保存为图片，如何用python自动做到这一点？不知屏幕前的小伙伴有没有遇到过类似的需求，此刻脑海里有木有一丢丢思路。python操作excel的第三方库有很多，个个都有各自的绝招和擅长的应用场景，简单罗列一下：pyexcel：pyexcel是......
  • pdf转换成excel有没有免费软件？6款pdf转excel软件大公开！
    如今pdf格式已成为我们日常生活中最常见的文件格式之一。尽管pdf非常适合存储大型文档和表格，但在需要对内容进行编辑时却显得有些不便。这正是为什么许多人希望将pdf转换成excel表格，以便更方便地进行数据修改和分析。然而，对于很多用户来说，如何高效地实现pdf转excel仍然是个难题......
  • 如何修改Excel表格而不丢失扩展名？
    我正在尝试修改Excel文件，其中包含许多VBA操作（不是我创建的）。我温和地尝试修改单个组合框项目。fromopenpyxlimportload_workbook#Loadtheworkbookworkbook=load_workbook('input.xlsx')#Selecttheworksheetworksheet=workbook['Monthly']#Changethe......
  • 人工智能-AI处理表格制作技巧：ExcelWPS三秒做表，大神到小白
    在数字化时代，数据处理和分析能力已成为职场人必备的技能之一。而表格处理软件，如Excel和WPS，更是日常工作中不可或缺的工具。但面对海量的数据和复杂的表格制作要求，很多人可能会感到手足无措。不过别担心，今天我将向大家揭示一个秘密武器——利用人工智能-AI处理表格制作技巧，只需......
  • excel 中如何将指定的空白单元格填充为指定的内容
     001、测试表格  002、选中，按F5 a、选定位条件 b、 c、直接输入一个测试文本 d、ctrl+enter 。 ......

赞助商

阅读排行

网站主页关于我们联系我们网站地图

本网站内容转载自其他媒体，侵权联系[admin##ips99.com]。

Copyright © 2020-2023 IPS99 版权所有 IPS99