Delphi7＋access 用Excelapplication控件导出DBGRID数据到EXCEL，使用"另存为"时出错

Question

本帖最后由 IYueMengw 于 2012-07-18 16:49:13 编辑

Answer 1

......implementationuses comobj;{$R *.dfm}Function DetailToExcel(xl_file:string;grid:Tdbgrid;T1:string='';T2:string='';T3:string=''):boolean;
var xlApp:Variant;
  i,j:integer;
  irow,icol:integer;
  TitleLines:integer;
  Titles:array [1..3] of string;
begin
  result:=false;
  if (not grid.DataSource.DataSet.Active) or (grid.DataSource.DataSet.RecordCount=0) then exit;
  Try
    xlapp:=createoleobject('Excel.application');
    xlapp.workbooks.Add(-4167);
    xlapp.visible:=true;
  Except
    showmessage('未安装Microsoft Excel !请安装!');
    exit
  end;
  //计算标题：
  Titles[1]:=T1;
  Titles[2]:=T2;
  Titles[3]:=T3;
  if T3<>'' then TitleLines:=3
  else if T2<>'' then TitleLines:=2
  else if T1<>'' then TitleLines:=1
  else TitleLines:=0;
  //填充列标题；
  irow:=grid.DataSource.DataSet.RecordCount;
  icol:=0;
  for i:=0 to grid.Columns.Count-1 do
  begin
    if grid.Columns[i].Visible then
    begin
      inc(icol);
      xlapp.cells[TitleLines+1,Icol]:=grid.Columns[i-1].Title.Caption;
      xlapp.cells[TitleLines+1,Icol]:=inttostr(icol);
    end;
  end;
  //填充标题；
  For i:=1 to TitleLines do
  begin
    xlapp.activesheet.cells[i,1]:=Titles[i];
    xlapp.activesheet.range['A'+IntToStr(i)+':'+chr(64+icol)+IntToStr(i)].select;
    xlapp.selection.HorizontalAlignment := -4108;
    xlapp.selection.VerticalAlignment := -4108;
    xlapp.selection.MergeCells := True;
    if i=1 then
    begin
      xlapp.selection.RowHeight:=26;
      xlapp.selection.Font.size:=18;
    end
    else
    begin
      xlapp.selection.RowHeight:=20;
      xlapp.selection.Font.size:=12;
    end;
  end;
  //设置表格线；
  xlapp.activesheet.range['A'+IntTostr(TitleLines+1)+':'+chr(64+icol)+Inttostr(irow+TitleLines+1)].select;
  xlapp.selection.Borders[4].linestyle:=1;
  xlapp.selection.Borders[3].linestyle:=1;
  xlapp.selection.Borders[2].linestyle:=1;
  xlapp.selection.Borders[1].linestyle:=1;
  xlapp.selection.Borders[11].linestyle:=1;
  xlapp.selection.Borders[12].linestyle:=1;
  //填充内容；
  grid.DataSource.DataSet.First;
  i:=TitleLines+2;
  while not grid.DataSource.DataSet.Eof do
  begin
    icol:=0;
    for j:=1 to grid.Columns.Count do
    begin
      if grid.Columns[j-1].Visible then
      begin
        inc(icol);
        xlapp.cells[i,icol]:=grid.Columns[j-1].Field.DisplayText;
      end;
    end;
    grid.DataSource.DataSet.Next;
    inc(i);
  end;
  For i:=1 to icol do
  begin
    xlapp.activesheet.Columns[i].select;
    xlapp.activesheet.Columns[i].EntireColumn.AutoFit;
  end;
  xlapp.activesheet.cells[1,1].select;
  if xl_File<>'' then
    xlapp.workbooks[1].SaveAs(xl_file);
  result:=true;
end;procedure TForm1.Button1Click(Sender: TObject);
begin
  if DBGrid1.DataSource.DataSet.RecordCount=0 then
    ShowMessage('没有内容!')
  else if DetailToExcel(ExtractFilePath(application.ExeName)+'DayDuty.xls',DBgrid1,'日统计') then
    ShowMessage('导出完成.')
end;
......

Answer 2

我测试过几次,没发现有错误呀,我的是XP+D7+Office2003

Answer 3

我的也是XP+D7+Office2003
第一次运行时没有问题，再运行后，提示DayDuty.xls文件存在，是否覆盖?选否，进入另存为界面，另存后就提示：‘类　Workbook 的　Saveas　方法无效’。但是到存储路径查看表也保存上了。

Answer 4

保存前判断一下文件是否存在？存在的就先删除旧的。if fileexists(xl_file) then
   deletefile(xl_file);