Delphi7 导出Dbgrid数据到Excel 默认路径设置为我的文档

delphi7 数据库设计 专栏收录该内容
8 篇文章 0 订阅


下面代码是自己写的,今天有个同学打电话问我
在Delphi7 导出Dbgrid数据到Excel 正好我最近写过 
也许会有更多的网友也会遇到类似的问题,把代码发下,
大家可以参考,有什么不足及需要改进的地方,请指教。

让我们共同学习。

procedure TFPeopleMgr.N6Click(Sender: TObject);
var
j:   integer;
filename:   string;
MSExcel,xlsheet,xlBook :   Variant;      //ole   ComObj
reg:Tregistry;
MYDocumentPath:   string; 
begin
IF DBGrid1.Fields[0].AsString='' then
begin
    Application.MessageBox('列表为空,无法导出!','错误操作',MB_OK+MB_ICONError);
    exit;
end;
//获得“我的文档”的路径
reg:=Tregistry.create;
reg.rootkey:=HKey_Current_User;
reg.openkey('Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders',false);
MYDocumentPath:=reg.READString('Personal');//“我的文档”的路径
SaveDialog1.InitialDir:=MYDocumentPath;
reg.closekey;
reg.free;
//导出数据
if TreeView_Dep.Selected=nil then
begin
    SaveDialog1.FileName:='人员信息 '+datetostr(now);
end
else
    SaveDialog1.FileName:=TreeView_Dep.Selected.Text+'人员信息 '+datetostr(now);

if SaveDialog1.Execute then
begin
    filename := concat(SaveDialog1.FileName,'.xls');
    try
       MSExcel:=CreateOLEObject('Excel.Application');
       xlBook:=MSExcel.WorkBooks.Add;
       xlsheet:=xlBook.Worksheets['sheet1'];
       xlsheet.Cells.item[1,1]:='编号';
       xlsheet.Cells.item[1,2]:='姓名';
       xlsheet.Cells.item[1,3]:='考勤号';
       xlsheet.Cells.item[1,4]:='单位';
       xlsheet.Cells.item[1,5]:='职务';
       j:=1;
       qe_ren.First;
       while   not   qe_ren.Eof   do   begin
         DBGrid1.SelectedRows.CurrentRowSelected   :=   True;
         xlsheet.Cells.item[j+1,1]:=DBGrid1.Fields[0].AsString;
         xlsheet.Cells.item[j+1,2]:=DBGrid1.Fields[1].AsString;
         xlsheet.Cells.item[j+1,3]:=DBGrid1.Fields[2].AsString;
         xlsheet.Cells.item[j+1,4]:=DBGrid1.Fields[3].AsString;
         xlsheet.Cells.item[j+1,5]:=DBGrid1.Fields[4].AsString;
         qe_ren.Next;
         j:=J+1;
       end;//while
       xlBook.SaveAs(filename);
       MSExcel.WorkBooks.close;
       MSExcel.Quit;
       MSExcel:=unassigned;
    except
      Application.Messagebox('Excel没有安装!','错误提示',MB_ICONERROR+mb_Ok);
      exit;
    end;//try
end;// end if SaveDialog1.Execute then

end;

转载请注明出处。


回复次数:3

  • 0
    点赞
  • 1
    评论
  • 0
    收藏
  • 一键三连
    一键三连
  • 扫一扫,分享海报

©️2021 CSDN 皮肤主题: 大白 设计师:CSDN官方博客 返回首页
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

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

余额充值