Delphi DataSetToExcel的三种方法

于 2018-09-13 16:09:27 发布
阅读量1.1k 收藏 2
点赞数
分类专栏： Delphi
版权声明：本文为博主原创文章，遵循 CC 4.0 BY-SA 版权协议，转载请附上原文出处链接和本声明。
本文链接：https://blog.csdn.net/qq_39951605/article/details/82689754
版权

function TWorkWindowForm.DataSetToExcel(cds_Temp: TClientDataSet; AcxGridDBTableView: TcxGridDBTableView; ToSavePath:string; var sMsg: string): Boolean;
var  
   XLS,WorkBook,WorkSheet: variant;
   i,m,n,Row,Col,RecNums: integer;
   sFieldName,
   SheetName,
   tmpSheetName: string;
   nSheetNums,nLoopCount,nMaxRows: Integer;
   cds_DataSet: TClientDataSet;
   dBeginTime: TDateTime;
begin
  Result := False;
  dBeginTime := Now;
  //检查数据完整性
  sMsg := '没有导出的数据或导出路径为空！';
  if not cds_Temp.Active then exit;
  if cds_Temp.RecordCount<=0 then exit;
  if AcxGridDBTableView.DataController.RecordCount<=0 then Exit;
  if ToSavePath = '' then Exit;

  if FileExists(ToSavePath) then
  begin
    CopyFile(PChar(ToSavePath),PChar('C:\temp.xls'),True);
    DeleteFile(ToSavePath);
  end;
  try
    RecNums := 0;
    nMaxRows := 65536;     //Excel2003最大行数
    nLoopCount := 1;       //循环次数----->针对循环sheet页
    Row := 2;              //从第2行开始写内容

    try
      XLS := createoleobject('Excel.Application');  //创建Excel工程
      WorkBook := XLS.WorkBooks.Add;  //新增一个工作簿
      WorkSheet := XLS.WorkSheets.Add; //新建一个Sheet
      XLS.Visible := False;
      SheetName := '数据目录1';  //第1个Sheet
      WorkSheet.Name := SheetName; //Sheet名称
      XLS.WorkSheets[SheetName].Activate;

      XLS.WorkSheets['Sheet1'].Activate; //设置一个活动的Sheet
      XLS.WorkSheets['Sheet1'].Delete;   //删除
      XLS.WorkSheets['Sheet2'].Activate;
      XLS.WorkSheets['Sheet2'].Delete;
      XLS.WorkSheets['Sheet3'].Activate;
      XLS.WorkSheets['Sheet3'].Delete;
    except
      CopyFile(PChar('C:\temp.xls'),PChar(ToSavePath),True);
      if FileExists('C:\temp.xls') then DeleteFile('C:\temp.xls');
      sMsg := '创建Excel失败,请确认安装Excel2003或以上版本！';
    end;

    try
      //写入表头
      m := AcxGridDBTableView.ItemCount;  //cxGrid列总数
      for i:=0 to m-1 do
      begin
        XLS.cells[1,i+1]:=AcxGridDBTableView.Columns[i].Caption;   //左上角第一个方格是[1,1]
      end;

      cds_DataSet := TClientDataSet.Create(nil);
      cds_DataSet.Data := cds_Temp.Data;
      RecNums := cds_DataSet.RecordCount;
      try//写入Excel数据
        cds_DataSet.DisableControls;
        cds_DataSet.First;
        while not cds_DataSet.Eof do
        begin
          for Col := 1 to m do
          begin
            sFieldName := AcxGridDBTableView.Columns[Col-1].DataBinding.FieldName;
            XLS.cells[Row,Col] := cds_DataSet.FieldByName(sFieldName).AsString;
          end;
        
          Inc(Row);
          if Row > nMaxRows then
          begin
            Inc(nLoopCount);   //循环次数
            //建立第下一个Sheet页,继续写数据
            SheetName := '数据目录'+inttostr(nLoopCount); //第i个Sheet
            WorkSheet := XLS.WorkSheets.Add; //新建一个Sheet
            XLS.Visible := False;
            WorkSheet.Name := SheetName; //Sheet名称
            XLS.WorkSheets[SheetName].Activate;

            //写入表头
            m := AcxGridDBTableView.ItemCount;  //cxGrid列总数
            for i:=0 to m-1 do
            begin
              XLS.cells[1,i+1]:=AcxGridDBTableView.Columns[i].Caption;   //左上角第一个方格是[1,1]
            end;
            Row := 2; //从第i个Sheet,第2行开始写内容
          end;

          cds_DataSet.Next;
        end;
      finally
        cds_DataSet.EnableControls;
        FreeAndNil(cds_DataSet);
      end;
    Except
      CopyFile(PChar('C:\temp.xls'),PChar(ToSavePath),True);
      if FileExists('C:\temp.xls') then DeleteFile('C:\temp.xls');
      sMsg := '写入Excel内容失败！';
    end;

      XLS.WorkBooks[1].SaveAs(ToSavePath, 56); //fileformat:=56 -- Office Excel 97-2003 format
  finally
    XLS.WorkBooks.Close; //关闭工作簿
    if not VarIsEmpty(XLS) then
       XLS.Quit;
    XLS := Unassigned;

    if FileExists('C:\temp.xls') then DeleteFile('C:\temp.xls');
  end;

  Result := True;
  n := SecondsBetween(Now,dBeginTime);
  Application.MessageBox(PChar('数据导出完毕，共计'+ inttostr(RecNums) + '条！【' + IntToStr(n) + '秒】'),'提示',MB_ICONINFORMATION + MB_OK);
end;

 

//第二种方法

function TWorkWindowForm.DataSetToExcel_ByClipbrd(DataSet: TClientDataSet; AcxGridDBTableView: TcxGridDBTableView; var sMsg: string): Boolean;
const
  xlNormal = -4143;
var
  sList: TStringList;
  sTitle, sData: string;
  WorkBook, WorkSheet: Variant;
  Excel: OleVariant;
  x, y, diff: Real;
  i, m, Cols,nRecCount, nLoopCount: Integer;
  SaveDialog: TSaveDialog;
  lv_sPath, sFieldName: string;
  cds_Temp: TClientDataSet;
  sExt, SheetName: string;
begin
  Result := False;
  if AcxGridDBTableView.DataController.RecordCount <= 0 then
  begin
    sMsg := '错误：没有检索数据！';
    Exit;
  end;
  if DataSet.IsEmpty then
  begin
    sMsg := '错误：没有检索到数据！';
    Exit;
  end;

  //获取保存文件名
  SaveDialog := TSaveDialog.Create(nil);
  try
    with SaveDialog do
    begin
      Filter := '*.xls|*.xls';
      if Execute then
        lv_sPath := SaveDialog.FileName;
      if lv_sPath = '' then
      begin
        sMsg := '错误：请输入文件名！';
        Exit;
      end;

      sExt := ExtractFileExt(lv_sPath);
      if UpperCase(sExt) <> UpperCase('.xls') then
        lv_sPath := lv_sPath + '.xls';
    end;
  finally
    FreeAndNil(SaveDialog);
  end;

  //判断是否存在文件
  if FileExists(lv_sPath) then
  begin
    if Application.MessageBox('该文件已经存在，要覆盖吗？', '询问', MB_YESNO + MB_ICONQUESTION) = IDYES then
    begin
      try
        DeleteFile(lv_sPath);
      except
        on E: Exception do
        begin
          sMsg := '错误：删除文件' + lv_sPath + '失败！';
          Exit;
        end;
      end;
    end
    else
    begin
      sMsg := '提示：未覆盖' + lv_sPath + '文件！';
      Exit;
    end;
  end;

  x := GetTickCount;  //开始时间
  //创建Excel
  try
    Excel := CreateOleObject('Excel.Application');
    WorkBook := Excel.WorkBooks.Add;  //新增一个工作簿
    WorkSheet := Excel.WorkSheets.Add;
    Excel.Visible := False;
    WorkSheet.Name := '数据目录1';   //Sheet名称
    Excel.WorkSheets['数据目录1'].Activate;

    //删除多余的Sheet
    Excel.WorkSheets['Sheet1'].Activate; //设置一个活动的Sheet
    Excel.WorkSheets['Sheet1'].Delete;   //删除
    Excel.WorkSheets['Sheet2'].Activate;
    Excel.WorkSheets['Sheet2'].Delete;
    Excel.WorkSheets['Sheet3'].Activate;
    Excel.WorkSheets['Sheet3'].Delete;
  except
    on E: Exception do
    begin
      sMsg := '错误：创建Excel失败,请确认安装Excel2003或以上版本--->' + e.Message;
      Exit;
    end;
  end;

  sList := TStringList.Create;
  cds_Temp := TClientDataSet.Create(nil);
  try
    cds_Temp.Data := DataSet.Data;  //复制数据
    nRecCount := cds_Temp.RecordCount;

    //写入每个Sheet页的第一行标题
    Cols := AcxGridDBTableView.ItemCount;  //cxGrid列总数
    for i:=0 to Cols-1 do
    begin
      sTitle := sTitle + AcxGridDBTableView.Columns[i].Caption + #9;   //左上角第一个方格是[1,1]
      Application.ProcessMessages;
    end;
    sList.Add(sTitle);

    try
      m := 1;
      nLoopCount := 1;  //第一Sheet页
      WorkSheet := Excel.Worksheets.Item[1];     //第1个Sheet页
      cds_Temp.First;
      while not cds_Temp.Eof do
      begin
        sData := '';
        for i := 1 to Cols do
        begin
          sFieldName := AcxGridDBTableView.Columns[i-1].DataBinding.FieldName;
          sData := sData + cds_Temp.FieldByName(sFieldName).AsString + #9;
          Application.ProcessMessages;
        end;
        sList.Add(sData);

        if m >= 3 then     //每个Sheet页允许3行数据
        begin
          //保存Sheet页
          Clipboard.AsText := sList.Text;
          WorkSheet.Paste;
          Clipboard.Clear;
          sList.Clear;
          sList.Add(sTitle);

          //准备下一个Sheet页
          Inc(nLoopCount);
          SheetName := '数据目录' + IntToStr(nLoopCount);
          WorkSheet := Excel.WorkSheets.Add; //新建一个Sheet
          Excel.Visible := False;
          WorkSheet.Name := SheetName;       //Sheet名称
//          Excel.WorkSheets[SheetName].Activate;
          WorkSheet := Excel.Worksheets.Item[1];     //第1个Sheet页

          //开始下一个Sheet页的处理
          m := 1;
          cds_Temp.Next;
          Continue;
        end;

        Inc(m);
        cds_Temp.next;
      end;
      Clipboard.Clear;
      Clipboard.AsText := sList.Text;
      WorkSheet.Paste;     //保存至第nSheetNo个Sheet页
    except
      on E: Exception do
      begin
        sMsg := 'E:Exception：拷贝数据异常--->' + e.Message;
        Exit;
      end;
    end;
  finally
    cds_Temp.Free;
    sList.Free;
  end;

  //保存Excel
  try
    Excel.ActiveWorkbook.SaveAs(lv_sPath, xlNormal, '', '', False, False);
    Excel.Visible := False; //true会自动打开已经保存的excel
    Excel.Quit;
    Excel := UnAssigned;

    y := GetTickCount;
    diff := (y-x)/1000; 
    sMsg := '数据导出完毕！【耗费' + FloatToStr(diff) + '秒】';
    Result := True;
  except
    on E: Exception do
    begin
      Excel.Quit;
      screen.cursor := crDefault;
      sMsg := 'E:Exception：保存Excel异常--->' + E.Message;
      Exit;
    end;
  end;
end;

 

//第三种方法

//导出数据到Excel
function TForm1.ToExcel(cxGridDBTableView: TcxGridDBTableView; var sMsg: string): Boolean;
var
  ExcelApp: Variant;
  i, j, k, m, n, x, y: integer;
  FileName,sExt: string;
  DlgSave: TsaveDialog;
  BookMark: TBookMark;
begin
  Result := False;

  if cxGridDBTableView.DataController.RecordCount = 0 then
  begin
    sMsg := '错误：没有可以导出的数据！';
    Exit;
  end;
  if cxGridDBTableView.DataController.DataSource.DataSet.IsEmpty then
  begin
    sMsg := '错误：数据集为空！';
    Exit;
  end;

  //获取保存路径
  DlgSave := TsaveDialog.Create(nil);
  try
    DlgSave.Filter := '*.xlsx|*.xlsx';
    if not DlgSave.Execute then
    begin
      sMsg := '错误：未保存文件路径！';
      Exit;
    end;
    FileName := DlgSave.FileName;
    if FileName = '' then
    begin
      sMsg := '错误：保存文件名为空！';
      Exit;
    end;
    sExt := ExtractFileExt(FileName);
    if sExt = '' then
    begin
      FileName := FileName + '.xlsx';
    end;
  finally
    FreeAndNil(DlgSave);
  end;

  if FileExists(FileName) then
  begin
    if Application.MessageBox(PChar('是否覆盖文件？'), '', MB_YESNO + MB_ICONQUESTION) = IDNO then
    begin
      sMsg := '错误：未覆盖相同文件！';
      Exit;
    end;
    try
      if not DeleteFile(FileName) then
      begin
        sMsg := '错误：无法删除此文件！';
        Exit;
      end;
    except
      on e: Exception do
      begin
        sMsg := '删除文件错误[Exception]：' + e.message;
        Exit;
      end;
    end;
  end;

  if not VarIsEmpty(ExcelApp) then
  begin
    ExcelApp.DisplayAlerts := False;
    ExcelApp.Quit;
    VarClear(ExcelApp);
  end;

  x := GetTickCount;  //开始计时
  try
    Application.ProcessMessages;
    ExcelApp := CreateOleObject('Excel.Application');
    ExcelApp.Caption := '深大调用Excel函数'; //'Microsoft Excel';
    ExcelApp.WorkBooks.Add;
    Application.ProcessMessages;
    ExcelApp.WorkSheets[1].Activate;         //第1个Sheet
  except
    on e: Exception do
    begin
      sMsg := '创建错误[Exception]：' + e.message;
      Exit;
    end;
  end;

  //第一行标题
  try
    k := 1;
    for i := 0 to cxGridDBTableView.ColumnCount - 1 do
    begin
      if cxGridDBTableView.Columns[i].Visible then
      begin
        ExcelApp.Cells[1, k] := cxGridDBTableView.Columns[i].Caption;
        k := k + 1;
      end; {if}
    end; {for}
    ExcelApp.rows[1].font.name := '宋体';
    ExcelApp.rows[1].font.size := 10;
    ExcelApp.rows[1].Font.Color := clBlack;
    ExcelApp.rows[1].Font.Bold := True;
  except
    on e: Exception do
    begin
      sMsg := '拷贝标题错误[Exception]：' + e.message;
      Exit;
    end;
  end;

  //写数据到Excel
  try
    cxGridDBTableView.DataController.DataSource.DataSet.DisableControls;
    try
      j := 1;
      m := cxGridDBTableView.DataController.DataSource.DataSet.RecordCount;
      BookMark := cxGridDBTableView.DataController.DataSource.DataSet.GetBookmark;
      for i := 0 to cxGridDBTableView.ColumnCount - 1 do
      begin
        if cxGridDBTableView.Columns[i].Visible then
        begin
          cxGridDBTableView.DataController.DataSource.DataSet.First;
          for k := 1 to cxGridDBTableView.DataController.DataSource.DataSet.RecordCount do
          begin
            ExcelApp.Cells[k + 1, j] := cxGridDBTableView.DataController.DataSource.DataSet.FieldByName(cxGridDBTableView.Columns[i].DataBinding.FieldName).Asstring;
            cxGridDBTableView.DataController.DataSource.DataSet.Next;
          end; {for}
          j := j + 1;
        end; {if}
      end; {for}

      for i := 1 to cxGridDBTableView.DataController.DataSource.DataSet.RecordCount + 1 do
        ExcelApp.rows[i].Font.SIZE := 9;
    finally
      cxGridDBTableView.DataController.DataSource.DataSet.GotoBookmark(BookMark);
      cxGridDBTableView.DataController.DataSource.DataSet.EnableControls;
    end;
  except
    on e: Exception do
    begin
      sMsg := '拷贝数据错误[Exception]：' + e.message;
      Exit;
    end;
  end;

  //保存Excel步骤
  try
    ExcelApp.Columns.AutoFit;
    ExcelApp.ActiveWorkBook.SaveAs(FileName);
    ExcelApp.WorkBooks.Close;
    ExcelApp.Quit;
    ExcelApp := Unassigned;
  except
    on e: Exception do
    begin
      sMsg := '保存数据错误[Exception]：' + e.message;
      Exit;
    end;
  end;

  y := GetTickCount;  //开始计时
  sMsg := '共计:' + IntToStr(m) + '数据导出完毕！【耗费:' + FloatToStr((y - x) / 1000) + '秒】';
  Result := True;
end;

qq_39951605
关注
专栏目录
Delphi使用DataSet读取数据生成Excel文件.rar
07-10
Delphi使用DataSet读取数据生成Excel文件，在代码中并没有使用OLE和ADO技术，将DataSet直接写入.XLS档(不需要Excel/不需要OLE/不需要ADO)。我想这个功能，特别是在一些大型的数据库软件系统中，涉及到数据报表的时候，具有很高的实用价值。
Delphi用DataSet生成Excel,无需OLE和ADO.rar
07-09
Delphi尝试了一下，不用OLE和ADO，直接用DataSet读取数据库中的内容并直接生成Excel文件，重点是如何生成XLS的代码，可能数据库丢失了，可将代码移植到你的项目中进行测试。
delphi导出数据至Excel的几种方法及比较
时光如流水的专栏
03-07 1983
delphi导出数据至Excel的几种方法及比较      一、delphi 快速导出excel uses ComObj,clipbrd; function ToExcel(sfilename:string; ADOQuery:TADOQuery):boolean; const       xlNormal=-4143; var   
Delphi从DataSet导出到Excel
henreash的专栏
04-15 3280
 Delphi从DataSet导出到ExcelExportDBGrid(toExcel:   Boolean);      var             bm:   TBookmark;             col,   row:   Integer;             sline:   String;               mem:   TMemo;            
delphi 把dataset里面数据 导 excel
07-26
本例是把数据库里面的数据通过delphi 写stream 方法导入到excel ,经测试 导一万笔记录 耗时不到3秒钟.且本人在导出时有加入进度条实时显示状态.使用方法 及例子都在代码中,如果你感觉有兴趣可以down下来参考下..希望对你有帮助 另下下来的档案需要用7-ZIP进行解压.
Delphi将数据集数据导出到EXCEL
10-08
Delphi将数据集数据导出到EXCEL;
DataSetToExcel
10-26
delphi DataSettoExcel
delphi 导出数据到excel
05-26
在Delphi中，导出数据到Excel是一项常见的任务，尤其对于需要处理大量数据或报表的应用程序。本教程将深入探讨如何使用Delphi轻松地完成这一操作。我们将主要关注两个核心概念：引用适当的单元和调用适当的方法。 ...
bdgrid+dataset to excel
09-27
#### 3.2 `ToExcel` 函数 此函数接受一个 `DBGridEh` 和一个 `TClientDataSet` 参数。它的主要功能是将数据写入 Excel 文件。首先，创建 Excel 应用程序对象并添加一个新的工作簿。然后，遍历 `DBGridEh` 的所有列以...
TscExcelExport 4.4-[delphi 导出excel文件].zip delphi 导出excel文件
最新发布
06-01
This TscExcelExport component is an advanced, powerful but easy to use component which enables you to export all records of a dataset from Embarcadero Delphi to Microsoft Excel. Many features are ...
Dataset2XLS_delphi_
09-30
Delphi使用DataSet创建Excel文件的源码实例
delphi表格数据导出到excel的控件
09-13
delphi 表格 数据导出到 excel，必须事先安装excel程序，亲测好用，支持delphi7
Delphi快速导出数据到Excel
01-07
背景：今天要把DataSet导入Excel，查询以前的贴子，一部分用Ole，速度太慢， 一部分用ADO连接到Excel文件，也很慢，一气之下把DBGrigEh的导出部分改了出来， 欢迎大家指教、改进。 功能：将数据集的数据导入Excel; 用法：With ExportXls.Create(TDataSet(ADOQuery1)) do Try Save2File(SaveDialog1.FileName, True); finally Free; end; 作者：Caidao (核心代码来自Ehlib) 时间：2003-04-09 地点：汕头我演测试的代码：特点：一、不需安装Excel即可导出。三、最多可以导出多少条，我没试，我试了5万条没有问题，时间也就是只需1-5分钟（我电脑较慢）。使用方法(注：别忘了uses DBGridToExcel;)：procedure TForm1.btn7Click(Sender: TObject);begin With ExportXls.Create(dbgrd1.DataSource.DataSet) do Try dlgSave1.DefaultExt := '.xls'; dlgSave1.Filter := 'Microsoft Excel 文件|*.xls'; if dlgSave1.Execute then begin Save2File(dlgSave1.FileName, True); end; finally Free; end;end;
delphi ExcelExport控件（导出到excel）
07-24
delphi 导出到excel 控件，很好用的
Delphi DbGrid导出到Excel
12-12
首先，你需要确保你的开发环境已经包含了用于数据库访问的组件，如DataSnap、ADO或BDE，以及处理Excel文件的组件，如Jedi VCL的JvExcelComponent或ZLib等第三方库。这些组件能够帮助我们读取DbGrid的数据并写入Excel...
DataSet to Excel
weixin_33778778的博客
11-26 163
private void toexcel(DataSet ds, string title) { StringBuilder sb = new StringBuilder(); Response.Clear(); Response.Buffer = false; Response...
Delphi 导出数据至Excel的7种方法
热门推荐
crkres9527
08-22 1万+
一; delphi 快速导出excel uses ComObj,clipbrd; function ToExcel(sfilename:string; ADOQuery:TADOQuery):boolean; const xlNormal=-4143; var y : integer; tsList : TStringList; s,filename :strin
Delphi中直接将DataSet中的数据写入Excel文件
weixin_34010566的博客
11-14 319
ProcedureTFormReport.ExportExcelFile(FileName:string;bWriteTitle:Boolean;aDataSet:TClientDataSet); var arXlsBegin:array[0..5]ofWord; arXlsEnd:array[0..1]ofWord; ...
Delphi DataSet超高效率导出到Excel——60万个数据9秒导出
z_ever的博客
01-08 1万+
Excel的ADO方法导出，60万个数据9秒导出。直接用SQL语句在Excel文件中追加需要导出的数据记录，代码简单明了，操作方便，效率较高（可能是仅次于文件流导出的方式）。
评论
添加红包

请填写红包祝福语或标题

个

红包个数最小为10个

元

红包金额最低5元

当前余额3.43元 前往充值 >
需支付：10.00元
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付元
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明：

1.余额是钱包充值的虚拟货币，按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载，可以购买VIP、付费专栏及课程。

余额充值