Delphi 数据导出到Excel

Posted

tags:

篇首语:本文由小常识网(cha138.com)小编为大家整理,主要介绍了Delphi 数据导出到Excel相关的知识,希望对你有一定的参考价值。

好多办公软件特别是财务软件,都需要配备把数据导出到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,
    1, 3);
  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 := 0;
    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[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);
//.....
implementation
//.....
Procedure ExportExcelFile(FileName: string; bWriteTitle: Boolean);
const
  coltitle: array [0 .. 3] of string = (第一行, 第二行, 第三行, 第四行);

type
  TArrContent = array [0 .. 3, 0 .. 3] 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) - 1 then
    begin
      Inc(row);
      Col := 0;
    end
    else
      Inc(Col);
  end;

  procedure WriteStringCell(AValue: AnsiString); // 写字符串数据, 在Delphi7之后的版本,string使用Unicode编码的,要AnsiString,不然会出现中文乱码
  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(AValue[1], 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;

// ......
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 := 0;
    row := 0;
    if bWriteTitle then
    begin
      for i := 0 to Length(coltitle) - 1 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 := 0 to RzListView1.Columns.Count - 1 do
    str := str + RzListView1.Columns[i].DisplayName + Char(9);
  str := str + #13;

  for i := 0 to RzListView1.Items.Count - 1 do
  begin
    str := str + RzListView1.Items[i].Caption + Char(9);
    for j := 0 to RzListView1.Items[i].SubItems.Count - 1 do
    begin
      str := str + RzListView1.Items[i].SubItems[j] + Char(9);
    end;

    str := str + #13;
  end;
  s := TStringList.Create;
  s.Add(str);
  s.SaveToFile(c:\\temp.xls); // 保存到c:\\temp.xls
  s.Free;
end;
TStringList转Excel

此方法不做详细解释

 

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

以上是关于Delphi 数据导出到Excel的主要内容,如果未能解决你的问题,请参考以下文章

delphi dbgrideh导入excel 中

Delphi 数据导出到Excel

DELPHI 导出到excel的问题,从数据库抓取数据并导出,按编号生成一个个独立的EXCEL文件

在delphi中如何将查询结果导出到excel中

Delphi 导出Excel

没有excel从Delphi导出到excel