Delphi 动态导出DBGrid To Excel

最新推荐文章于 2024-11-21 15:01:56 发布

原创最新推荐文章于 2024-11-21 15:01:56 发布 · 5.9k 阅读

5 ·

本内容遵循CC 4.0 BY-SA版权协议

标签

#delphi #excel #microsoft #integer #string

delphi 专栏收录该内容

63 篇文章

订阅专栏

本文提供了一个通用的Delphi程序，能够将TDBGRID组件中的数据导出到Excel文件中，包括每行的标题，并且支持自定义Excel列宽和字体颜色。

开发板推荐：天空星STM32F407VET6开发板

超高性价比 STM32主控 | 超高主频 | 一板兼容百芯 | 比赛神器 | 沉金彩色丝印

点击查看

经常会遇到DBGRID 转入到EXCEL中的情况，所以写了个通用程序，希望对大家有用。

procedure TDM.DBGridExport(GRID:TDBGRID);

var       //DBGRID控件内容存储到EXCEL 只有第一行有标题
    EclApp:Variant;
    XlsFileName:String;
    sh:olevariant;
    i,j:integer;
    s:string;
    savedailog:TSaveDialog;
begin
   savedailog:=TSaveDialog.Create(Self);
   savedailog.Filter:='Excel files (*.xls)|*.XlS';
   if savedailog.Execute then begin
        xlsfilename:=savedailog.FileName;
        savedailog.Free;
     end
   else begin
      savedailog.Free;
      exit;
   end;
   try
      eclapp:=createOleObject('Excel.Application');
      sh:=CreateOleObject('Excel.Sheet');
   except
      showmessage('您的机器里未安装Microsoft Excel。');
      exit;
   end;
   try
      sh:=eclapp.workBooks.add;
      With Grid.DataSource.DataSet do begin
        First;
        i:=GRID.FieldCount-1;
        j:=i div 26;
        s:='';
        if j>0 then s:=s+chr(64+j);
        for i:=0 to grid.FieldCount-1 do begin
           if grid.Fields[i].Visible then begin
              eclapp.cells[2,i+1]:=grid.Fields[i].DisplayName;
              if GRID.Fields[i].DisplayWidth>80 then
                 eclapp.columns[i+1].Columnwidth:=80
              else
                 eclapp.columns[i+1].Columnwidth:=GRID.Fields[i].DisplayWidth+0.3;
              eclapp.cells[2,i+1].Font.Color:=clRed;
//转EXCEL时过长的数字有截取现象。已改为用‘来解决，所以下面不需要了。
//              if (grid.Fields[i].DisplayName='身份证号') or (grid.Fields[i].DisplayName='银行帐号') then begin
//                 eclapp.columns[i+1].NumberFormat:='@';
//              end;
           end;
        end;
        for i:=1 to RecordCount do begin
            for j:=0 to grid.FieldCount-1 do
              if grid.Fields[j].Visible then
                 if GRID.Fields[j].DisplayText>'' then begin
//                   if length(grid.Fields[j].DisplayText)>=15 then
//                      eclapp.cells[i*2+1,j+1].NumberFormatLocal:='@';
                   eclapp.cells[i+2,j+1]:=grid.Fields[j].DisplayText;
                 end;
            Next;
        end;
     end;
      sh.saveas(xlsfilename);
      sh.close;
      eclapp.quit;
      ShowMessage('输出 Excel 文件已完成...');
   except
      showmessage('Excel系统出错！！！');
      sh.close;
      eclapp.quit;
      exit;
   end;
end;

========================每行都有标题说明的转出EXCEL==========================

procedure TDM.SingleDBGridExport(GRID: TDBGRID);
var       //DBGRID控件内容存储到EXCEL
    EclApp:Variant;
    XlsFileName:String;
    sh:olevariant;
    i,j,z:integer;
    s:string;
    savedailog:TSaveDialog;
begin
   savedailog:=TSaveDialog.Create(Self);
   savedailog.Filter:='Excel files (*.xls)|*.XlS';
   if savedailog.Execute then begin
        xlsfilename:=savedailog.FileName;
        savedailog.Free;
     end
   else begin
      savedailog.Free;
      exit;
   end;
   try
      eclapp:=createOleObject('Excel.Application');
      sh:=CreateOleObject('Excel.Sheet');
   except
      showmessage('您的机器里未安装Microsoft Excel。');
      exit;
   end;
   try
      sh:=eclapp.workBooks.add;
      With Grid.DataSource.DataSet do begin
        First;
        z:=GRID.FieldCount-1;
        j:=i div 26;
        s:='';
        if j>0 then s:=s+chr(64+j);
        for i:=1 to RecordCount do begin
           for z:=0 to grid.FieldCount-1 do begin
             if grid.Fields[z].Visible then begin
                eclapp.cells[i*2,z+1]:=grid.Fields[z].DisplayName;
                if GRID.Fields[z].DisplayWidth>80 then
                   eclapp.columns[z+1].Columnwidth:=80
                else
                   eclapp.columns[z+1].Columnwidth:=GRID.Fields[z].DisplayWidth+0.3;
                eclapp.cells[i*2,z+1].Font.Color:=clRed;
             end;
           end;
          //
            for j:=0 to grid.FieldCount-1 do
              if grid.Fields[j].Visible then
                 if GRID.Fields[j].DisplayText>'' then begin
                   eclapp.cells[i*2+1,j+1]:=grid.Fields[j].DisplayText;
                 end;
            Next;
        end;
     end;
      sh.saveas(xlsfilename);
      sh.close;
      eclapp.quit;
      ShowMessage('输出 Excel 文件已完成...');
   except
      showmessage('Excel系统出错！！！');
      sh.close;
      eclapp.quit;
      exit;
   end;
end;