Delphi 数据导出到Excel

2021-08-22 03:10:03

好多办公软件特别是财务软件，都需要配备把数据导出到Excel，下面就来介绍两种数据导出方法

1.ADODB导出查询结果（此方法需要安装Excel）

2.二维表数据导出（根据Excel文件结构生成二进制文件流，不需要安装Excel）

3.如果涉及到复杂表头的（例如合并字段等），未做研究，下面也没介绍相关资料，请止步。

第一种，ADODB导出查询结果（此方法需要安装Excel）

//uses DB, ADODB, ComObj, ComCtrls,  excel2000,  StdCtrls, adoint,

var

  xlApp, xlBook, xlSheet, xlQuery: Variant;

  adoConnection, adoRecordset: Variant;

begin

  adoConnection := CreateOleobject('ADODB.Connection');

  adoRecordset := CreateOleobject('ADODB.Recordset');

  adoConnection.Open(

    'Provider=MSDASQL.1;Password=000000;Persist Security Info=True;User ID=my_username;Data Source=tax_ora;Extended Properties="DSN=tax_ora;UID=net_user;PWD=000000;DBQ=TAX_ORA101;DBA=W;APA=T;EXC=F;FEN=T;QTO=T;' + 'FRC=10;FDL=10;LOB=T;RST=T;BTD=F;BNF=F;BAM=IfAllSuccessful;NUM=NLS;DPM=F;MTS=T;MDI=F;CSR=F;FWC=F;FBS=64000;TLO=O;MLD=0;ODA=F;"');

  adoRecordset.CursorLocation := adUseClient;

  adoRecordset.Open('select * from userinfo where rownum<100', adoConnection,

    , );

  try

    xlApp := CreateOleobject('Excel.Application');

    xlBook := xlApp.Workbooks.Add;

    xlSheet := xlBook.WorkSheets['sheet1'];

    // 设置这一列为 文本列 ，让 "00123" 正确显示，而不是自动转换为"123"

    xlSheet.Columns['C:C'].NumberFormatLocal := '@';

    xlApp.Visible := True;

    // 把查询结果导入EXCEL数据

    xlQuery := xlSheet.QueryTables.Add(adoRecordset, xlSheet.Range['A1']);

    // 关键是这一句

    xlQuery.FieldNames := True;

    xlQuery.RowNumbers := False;

    xlQuery.FillAdjacentFormulas := False;

    xlQuery.PreserveFormatting := True;

    xlQuery.RefreshOnFileOpen := False;

    xlQuery.BackgroundQuery := True;

    // xlQuery.RefreshStyle := xlInsertDeleteCells;

    xlQuery.SavePassword := True;

    xlQuery.SaveData := True;

    xlQuery.AdjustColumnWidth := True;

    xlQuery.RefreshPeriod := ;

    xlQuery.PreserveColumnInfo := True;

    xlQuery.FieldNames := True;

    xlQuery.Refresh;

    xlBook.SaveAs('c:\fromD.xls', xlNormal, '', '', False, False);

  finally

    if not VarIsEmpty(xlApp) then

    begin

      xlApp.DisplayAlerts := False;

      xlApp.ScreenUpdating := True;

      xlApp.Quit;

    end;

  end;

end;

ADODB导出查询结果

第二种，不需要安装Excel是它的绝对优势，而且不限于数据库表查询，你还可以导出listview，甚至你自定义的record数据。

var

  arXlsBegin: array[..] of Word = ($, , , $, , );

  arXlsEnd: array[..] of Word = ($0A, );

  arXlsString: array[..] of Word = ($, , , , , );

  arXlsNumber: array[..] of Word = ($, , , , );

  arXlsInteger: array[..] of Word = ($27E, , , , );

  arXlsBlank: array[..] of Word = ($, , , , $);

Procedure ExportExcelFile(FileName: string; bWriteTitle: Boolean);

//.....

implementation

//.....

Procedure ExportExcelFile(FileName: string; bWriteTitle: Boolean);

const

  coltitle: array [ .. ] of string = ('第一行', '第二行', '第三行', '第四行');

type

  TArrContent = array [ .. ,  .. ] of string;

var

  i, j: Integer;

  Col, row: Word;

  ABookMark: TBookMark;

  aFileStream: TFileStream;

  A: TArrContent;

  // ......

  procedure incColRow; // 增加行列号

  begin

    // if Col = aDataSet.FieldCount - 1 then

    if Col = Length(coltitle) -  then

    begin

      Inc(row);

      Col := ;

    end

    else

      Inc(Col);

  end;

  procedure WriteStringCell(AValue: AnsiString); // 写字符串数据, 在Delphi7之后的版本，string使用Unicode编码的，要AnsiString，不然会出现中文乱码

  var

    L: Word;

  begin

    L := Length(AValue);

    arXlsString[] :=  + L;

    arXlsString[] := row;

    arXlsString[] := Col;

    arXlsString[] := L;

    aFileStream.WriteBuffer(arXlsString, SizeOf(arXlsString));

    aFileStream.WriteBuffer(AValue[], L);

    incColRow;

  end;

  procedure WriteIntegerCell(AValue: Integer); // 写整数

  var

    V: Integer;

  begin

    arXlsInteger[] := row;

    arXlsInteger[] := Col;

    aFileStream.WriteBuffer(arXlsInteger, SizeOf(arXlsInteger));

    V := (AValue shl ) or ;

    aFileStream.WriteBuffer(V, );

    incColRow;

  end;

  procedure WriteFloatCell(AValue: double); // 写浮点数

  begin

    arXlsNumber[] := row;

    arXlsNumber[] := Col;

    aFileStream.WriteBuffer(arXlsNumber, SizeOf(arXlsNumber));

    aFileStream.WriteBuffer(AValue, );

    incColRow;

  end;

// ......

begin

  for i := Low(A) to High(A) do

  begin

    for j := Low(A[i]) to High(A[i]) do

      A[i, j] := IntToStr(i) + ',' + IntToStr(j) + ' ';

  end;

  if FileExists(FileName) then

    DeleteFile(FileName); // 文件存在，先删除

  aFileStream := TFileStream.Create(FileName, fmCreate);

  Try // 写文件头

    aFileStream.WriteBuffer(arXlsBegin, SizeOf(arXlsBegin)); // 写列头

    Col := ;

    row := ;

    if bWriteTitle then

    begin

      for i :=  to Length(coltitle) -  do

        WriteStringCell(coltitle[i]);

    end;

    for i := Low(A) to High(A) do

    begin

      for J := Low(A) to High(A) do

      begin

        WriteStringCell(A[i, j]);

        //此处可以判断A[i, j]的数据类型，分别调用

        //WriteIntegerCell()

        //WriteFloatCell()

      end;

    end;

    // 写文件尾

    aFileStream.WriteBuffer(arXlsEnd, SizeOf(arXlsEnd));

  Finally

    aFileStream.Free;

  end;

end;

文件流形式导出Excel

ExportExcelFile('d:\数据2.xls', True);

调用

调用结果

三、有一种直接把TStringList保存为Excel的，也可以，很方便，但是遇到数值字段的时候会变成科学记数法形式，所以我没有使用这个方法。

var

  s: TStringList;

  str: string;

  i, j: Integer;

begin

  str := '';

  for i :=  to RzListView1.Columns.Count -  do

    str := str + RzListView1.Columns[i].DisplayName + Char();

  str := str + #;

  for i :=  to RzListView1.Items.Count -  do

  begin

    str := str + RzListView1.Items[i].Caption + Char();

    for j :=  to RzListView1.Items[i].SubItems.Count -  do

    begin

      str := str + RzListView1.Items[i].SubItems[j] + Char();

    end;

    str := str + #;

  end;

  s := TStringList.Create;

  s.Add(str);

  s.SaveToFile('c:\temp.xls'); // 保存到c:\temp.xls

  s.Free;

end;

TStringList转Excel

此方法不做详细解释

此文章参考资料来自：Delphi 导出数据至Excel的7种方法

码农公寓

相关文章