导出多张dbgrid到excel时出现奇怪现象

Question

以下一段代码在前天运行时非常正常，但昨天出现异常，总提示指针不正确。
   俺试了n久直到现在。得出基本症状如下：
                      单击按钮一次时，excel中生成的sheet只是上次设顶的数目。
                     比如：上次运行时设XLApp.SheetsInNewWorkbook :=3;上次运行完设为6，但运行后点击一次bbutton1，sheet的数目还是3。但点击button1两次时sheet数目才为6。不知什么原因。
procedure TForm1.Button1Click(Sender: TObject);
var
  iCount, jCount: Integer;
  XLApp: Variant;
  Sheet: Variant;
  I: Integer;
begin
  Screen.Cursor := crHourGlass;
  try
    XLApp:=CreateOleObject('Excel.Application');
  except
    Screen.Cursor := crDefault;
    Exit;
  end;
   if not VarIsEmpty(XLApp) then//如果存在则清除
  begin
    XLApp.DisplayAlerts := False;
    XLApp.Quit;
    VarClear(XLApp);
  end;
    try
    XLApp:=CreateOleObject('Excel.Application');
  except
    Screen.Cursor := crDefault;
    Exit;
  end;
  XLApp.WorkBooks.Add;
  XLApp.SheetsInNewWorkbook :=3;
  XlApp.Visible := True;
 end;

Answer 1

你的代码有点乱!
给你一个!
procedure TPrintSQL_Data.PrintSqlDataToExcel;
var
  I:integer;
  Range,ExcelApp,V:variant;
begin
    Try
      ExcelApp:=CreateOleObject('Excel.application');
    Except
      MessageDlg('没有安装Office 办公软件Excel!',mtinformation,[MBOK],0);
      exit;
    End;    try
    ExcelApp.WorkBooks.add(Null);
    V:=ExcelApp.WorkBooks[1].WorkSheets[1];    //*开始设计标题*/
    Range:=V.Range['A1',GetExcelCoulmnCaption(DataSet.Fields.Count)+'1'];
    Range.MergeCells:=true;
    Range.RowHeight:=24;
    Range.HoriZontalAlignMent:=xlCenter;
    Range.VerticalAlignMent:=xlCenter;
    Range.Font.Name:='新宋体';
    Range.Font.size:=16;
    Range.Font.FontStyle:='加粗';
    Range.Value:=FExcelTitle;
    Range.Borders.LineStyle:=xlContinuous;  //边框
    Range.Borders.Weight:=xlThin;
    Range.Borders.ColorIndex:=xlAutomatic;    //显示标题
     For i:=0 To DataSet.Fields.Count-1 Do
     begin
       Range:=V.Range[GetExcelCoulmnCaption(I+1)+'2',GetExcelCoulmnCaption(I+1)+'2'];
       Range.RowHeight:=24;
       Range.HoriZontalAlignMent:=xlCenter;
       Range.VerticalAlignMent:=xlCenter;
       Range.Font.Name:='新宋体';
       Range.Font.size:=9;
       Range.Font.FontStyle:='加粗';
       Range.Columns.AutoFit;
       Range.Value:=DataSet.Fields[I].FieldName;
       Range.Borders.LineStyle:=xlContinuous;  //边框
       Range.Borders.Weight:=xlThin;
       Range.Borders.ColorIndex:=xlAutomatic;
     end;
     //显示内容
     //set
      Range:=V.Range['A3',GetExcelCoulmnCaption(DataSet.FieldCount)+IntToStr(DataSet.recordcount+2)];
      Range.NumberFormatLocal:= '@';
      Range.RowHeight:=20;
      Range.HoriZontalAlignMent:=xlCenter;
      Range.VerticalAlignMent:=xlCenter;
      Range.Borders.LineStyle:=xlContinuous;  //边框
      Range.Borders.Weight:=xlThin;
      Range.Borders.ColorIndex:=xlAutomatic;
      Range.Font.Name:='新宋体';
      Range.Font.size:=9;
      Range.Columns.AutoFit;     DataSet.First;
     While (Not DataSet.Eof) do
     begin
        For i:=0 To DataSet.Fields.Count-1 Do
        begin
             Range:=V.Range[GetExcelCoulmnCaption(I+1)+IntToStr(DataSet.RecNo+2),GetExcelCoulmnCaption(I+1)+IntToStr(DataSet.RecNo+2)];
             if  DataSet.Fields[I].IsNull then
             Range.Value:=' '
             else
             Range.Value:=DataSet.Fields[I].AsString;
             Range.Borders.LineStyle:=xlContinuous;  //边框
             Range.Borders.Weight:=xlThin;
             Range.Borders.ColorIndex:=xlAutomatic;
        end;
        DataSet.next;
     end;
     
    //显示Excel文档界面
    ExcelApp.visible:=true;
    V.Activate;
    finally
       //释放接口对象
        ExcelApp:=unassigned;
        V:= unassigned;
        Range:=unassigned;
    end;
end;

Answer 2

补充!:
function TPrintSQL_Data.GetExcelCoulmnCaption(num: Cardinal): string;
var
  mod_num,div_num:Cardinal;
begin
   if num=0 then exit;
   if (num mod 26=0) then mod_num:=26
   else mod_num:=num mod 26;
   div_num:=num div 26;
   if mod_num=26 then DEC(div_num);
   if div_num=0 then
   Result:=Chr(64+mod_num)
   else Result:=Chr(64+div_num)+Chr(64+mod_num);
end;

Answer 3

你的不大好导出多张表。
我那段程序也上一在csdn上找的，开始用的很好的啊。
但过段时间怎么就那样了呢。

Answer 4

不明白你的XLApp為什麼要創建兩次呀.

Answer 5

自由界面和报表的完美解决方案！
http://www.anylib.com

Answer 6

为什么不用cxGrid呢, 它里面有个ExportGrid4ToExcel功能, 兼容性好.procedure ExportGrid4ToExcel(const AFileName: string; AGrid: TcxGrid; AExpand: Boolean = True; ASaveAll: Boolean = True; AUseNativeFormat: Boolean = True; const AFileExt: string = xls?;一次搞定

Answer 7

兄弟姐妹们，俺终于找到方法了。只许须加一句就一切ok了！！！
procedure TForm1.Button1Click(Sender: TObject);
var
  iCount, jCount: Integer;
  XLApp: Variant;
  Sheet: Variant;
  I: Integer;
begin
  Screen.Cursor := crHourGlass;
  try
    XLApp:=CreateOleObject('Excel.Application');
  except
    Screen.Cursor := crDefault;
    Exit;
  end;
   if not VarIsEmpty(XLApp) then//如果存在则清除
  begin
    XLApp.DisplayAlerts := False;
    XLApp.Quit;
    VarClear(XLApp);
  end;
    try
    XLApp:=CreateOleObject('Excel.Application');
  except
    Screen.Cursor := crDefault;
    Exit;
  end;
  XLApp.SheetsInNewWorkbook :=3;///////////////////////这里！！！！！！！！！！！！！
  XLApp.WorkBooks.Add;
  XLApp.SheetsInNewWorkbook :=3;
  XlApp.Visible := True;
 end;