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

来源：互联网发布：java 发联机报文编辑：程序博客网时间：2024/05/17 19:22

下面代码是自己写的，今天有个同学打电话问我
在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;

转载请注明出处。

在使用控件dbgrideh导出excel后，excel2010提示文件已损坏，想通过程序判断excel的版本，如果是2010版就通过ole导出，（通过注册表或者文件目录等其他方法都可以），望高手指点！！

对我有用[0] 丢个板砖[0] 引用 | 举报 | 管理

回复次数：3

: xiaojun5556; xiaojun5556; 等级：

#1 得分：40回复于： 2012-12-18 14:00:32

function hasExcel2010(): Boolean;
var
  MyReg: TRegistry;
begin
// HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\SOFTWARE\Microsoft\Office\14.0
  Result := False;
  MyReg := TRegistry.Create;
  try
    MyReg.RootKey := HKEY_LOCAL_MACHINE;
    if MyReg.OpenKey('\SOFTWARE\', FALSE) then
    begin
       if MyReg.OpenKey('\SOFTWARE\Microsoft\Office\Software\Microsoft\Office\14.0', FALSE) then
       begin
         Result := True;
       end
       else if MyReg.OpenKey('\SOFTWARE\Microsoft\Office\14.0\Excel\InstallRoot', FALSE) then
       begin
         Result := MyReg.ValueExists('Path');
       end
       else if MyReg.OpenKey('\SOFTWARE\Microsoft\Office\14.0', FALSE) then
       begin
         Result := True;
       end;
       MyReg.CloseKey;
    end;
  finally
    MyReg.Free;
  end;
end;

function hasExcel2007(): Boolean;
var
  MyReg: TRegistry;
begin
// HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\12.0\Excel\InstallRoot\Path: C:\Program Files\...
  Result := False;
  MyReg := TRegistry.Create;
  try
    MyReg.RootKey := HKEY_LOCAL_MACHINE;
    if MyReg.OpenKey('\SOFTWARE\', FALSE) then
    begin
       if MyReg.OpenKey('\SOFTWARE\Microsoft\Office\12.0\Excel\InstallRoot', FALSE) then
       begin
         Result := MyReg.ValueExists('Path');
       end;
       MyReg.CloseKey;
    end;
  finally
    MyReg.Free;
  end;
end;

2014年1月微软MVP当选名单揭晓！

对我有用[0] 丢个板砖[0] 引用 | 举报 | 管理

: szto2003; szto2003; 等级：

#2 得分：0回复于： 2012-12-18 18:44:34

能用HKEY_CURRENT_USER下面的判断吗，因为好多公司的电脑没有HKEY_LOCAL_MACHINE的访问权限！！

0 0