如何将几个DBGRID里的内容导入同一个EXCEL表中....的问题--各位大侠进来看看....

Question

http://dev.csdn.net/article/53/53442.shtm
如何将几个DBGRID里的内容导入同一个EXCEL表中？
在软件实际制作中，为节省开发成本和开发周期，一些软件人员通常会吧DBGrid中的数据直接导出到Excel表中，而先前能看到的函数仅仅只能在WorkBook的一个Sheet中导入数据，不支持多Sheet！。~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids, DBGrids, DB, ADODB,comobj;type
  TForm1 = class(TForm)
    ADOConnection1: TADOConnection;
    ADOTable1: TADOTable;
    ADOTable2: TADOTable;
    ADOTable3: TADOTable;
    DataSource1: TDataSource;
    DataSource2: TDataSource;
    DataSource3: TDataSource;
    DBGrid1: TDBGrid;
    DBGrid2: TDBGrid;
    DBGrid3: TDBGrid;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure CopyDbDataToExcel(Args: array of const);
  end;var
  Form1: TForm1;implementation{$R *.dfm}
procedure TForm1.CopyDbDataToExcel(Args: array of const);
var
iCount, jCount: Integer;
XLApp: Variant;
Sheet: Variant;
I: Integer;
begin
Screen.Cursor := crHourGlass;
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 := High(Args) + 1;for I := Low(Args) to High(Args) do
begin ShowMessage(IntToStr(i+1));
 XLApp.WorkBooks[1].WorkSheets[I+1].Name := TDBGrid(Args[I].VObject).Name;  //运行时提示：无效索引...前面showmessage已经显示的顺序:1,2,3 在显示3之后程序中断,但从grid中可以看出DBgrid1,dbgrid2已经被导出，就是导第三个时就出错 Sheet := XLApp.Workbooks[1].WorkSheets[TDBGrid(Args[I].VObject).Name];
 if not TDBGrid(Args[I].VObject).DataSource.DataSet.Active then
 begin
 Screen.Cursor := crDefault;
 Exit;
 end; TDBGrid(Args[I].VObject).DataSource.DataSet.first;
 for iCount := 0 to TDBGrid(Args[I].VObject).Columns.Count - 1 do
 Sheet.Cells[1, iCount + 1] := TDBGrid(Args[I].VObject).Columns.Items[iCount].Title.Caption; jCount := 1;
 while not TDBGrid(Args[I].VObject).DataSource.DataSet.Eof do
 begin
 for iCount := 0 to TDBGrid(Args[I].VObject).Columns.Count - 1 do
 Sheet.Cells[jCount + 1, iCount + 1] := TDBGrid(Args[I].VObject).Columns.Items[iCount].Field.AsString; Inc(jCount);
 TDBGrid(Args[I].VObject).DataSource.DataSet.Next;
 end;
end;XlApp.Visible := True;
Screen.Cursor := crDefault;
end; 
procedure TForm1.Button1Click(Sender: TObject);
begin
form1.CopyDbDataToExcel([dbgrid1,dbgrid2,dbgrid3]);
end;end.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~form1.CopyDbDataToExcel([dbgrid1,dbgrid2]);导出两个就可以,没有任何问题...
form1.CopyDbDataToExcel([dbgrid1,dbgrid2,dbgrid3]);//为什么导出两个以上就不行了???
在两台机上试了，还是不行...郁闷
不知哪位大侠用过这个导出多个grid的例子...有没有碰到这种情况...还请各位指点一下...^_^

Answer 1

刚写的把多个Dbgrid导如到一个Excel表中:(Win2k,delphi6)
单元应用：
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, DB, DBTables, Grids, DBGrids, ActiveX, ComObj,
Excel2000, OleServer;procedure CopyDbDataToExcel(Args: array of const);
var
  iCount, jCount: Integer;
  XLApp: Variant;
  Sheet: Variant;
  I: Integer;
begin
  Screen.Cursor := crHourGlass;
  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 := High(Args) + 1;  for I := Low(Args) to High(Args) do
  begin
    XLApp.WorkBooks[1].WorkSheets[I+1].Name := TDBGrid(Args[I].VObject).Name;
    Sheet := XLApp.Workbooks[1].WorkSheets[TDBGrid(Args[I].VObject).Name];    if not TDBGrid(Args[I].VObject).DataSource.DataSet.Active then
    begin
      Screen.Cursor := crDefault;
      Exit;
    end;    TDBGrid(Args[I].VObject).DataSource.DataSet.first;
    for iCount := 0 to TDBGrid(Args[I].VObject).Columns.Count - 1 do
      Sheet.Cells[1, iCount + 1] := TDBGrid(Args[I].VObject).Columns.Items[iCount].Title.Caption;    jCount := 1;
    while not TDBGrid(Args[I].VObject).DataSource.DataSet.Eof do
    begin
      for iCount := 0 to TDBGrid(Args[I].VObject).Columns.Count - 1 do
        Sheet.Cells[jCount + 1, iCount + 1] := TDBGrid(Args[I].VObject).Columns.Items[iCount].Field.AsString;      Inc(jCount);
      TDBGrid(Args[I].VObject).DataSource.DataSet.Next;
    end;
  end;  XlApp.Visible := True;
  Screen.Cursor := crDefault;
end;

Answer 2

to: fhuibo(永远深爱一个叫“莎“的好女孩儿)
谢谢！但是你的代码跟我用的那个一模一样啊，你试过可以导多个grid吗......

Answer 3

和导一个表没有区别。 在程序中指定往那一个SHEETS中就行了。

Answer 4

to 楼上:后来我又重装了一次office2000。
开始用form1.CopyDbDataToExcel([dbgrid1,dbgrid2,dbgrid3]);//没问题，可以导出多个DBGrid
再胡乱form1.CopyDbDataToExcel([dbgrid1,dbgrid3,dbgrid2,dbgrid6,dbgrid4]);//随便几次之后..
再运行就提示：无效索引，似乎导了两个就导不下去了。
然后就：form1.CopyDbDataToExcel([dbgrid1,dbgrid2]);导出两个就可以，但Form1.CopyDbDataToExcel([dbgrid1,dbgrid2,dbgrid3]);//导出两个以上就不行了刚刚不能在本机导出多个grid的那个程序在其它的机子里又可以导....
似乎要重装一次office2000才能继续运行程序，不提示'效索引'个错误...￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣
请各位大侠看看如何才能不出现这种情况.........(如不够可以加)( 或者，哪位有更好的，也请您指点一下)....谢谢啦...^_^

Answer 5

学习，自己经常用的办法是用循环直接给EXCEL赋值，这样出错误的几率很小。

Answer 6

建议直接用sql语句把擦春出来的数据直接导入到Excel，不通过dbgrid

Answer 7

什么多个dbgrid，实际上是多个数据集，定义好sheet，然后用代码从数据集里面取出数据写进相应的sheet就行了，我都不知道做过多少次这样的事情了。只是要注意写数据的格式和excel的单元格的格式罢了！没有太大的难度。

Answer 8

这里最好不要用sql直接导入，因为数据库的字段格式和excel的单元格的格式有差异，很难控制。多写一点代码而已！

Answer 9

刚写的把多个Dbgrid导如到一个Excel表中:(Win2k,delphi6)
单元应用：
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, DB, DBTables, Grids, DBGrids, ActiveX, ComObj,
Excel2000, OleServer;procedure CopyDbDataToExcel(Args: array of const);
var
  iCount, jCount: Integer;
  XLApp: Variant;
  Sheet: Variant;
  I: Integer;
begin
  Screen.Cursor := crHourGlass;
  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;//  (1)
  XLApp.SheetsInNewWorkbook := High(Args) + 1;//  (2)
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  XLApp.SheetsInNewWorkbook := High(Args) + 1; 
  XLApp.WorkBooks.Add;  
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  for I := Low(Args) to High(Args) do
  begin
    XLApp.WorkBooks[1].WorkSheets[I+1].Name := TDBGrid(Args[I].VObject).Name;
    Sheet := XLApp.Workbooks[1].WorkSheets[TDBGrid(Args[I].VObject).Name];    if not TDBGrid(Args[I].VObject).DataSource.DataSet.Active then
    begin
      Screen.Cursor := crDefault;
      Exit;
    end;    TDBGrid(Args[I].VObject).DataSource.DataSet.first;
    for iCount := 0 to TDBGrid(Args[I].VObject).Columns.Count - 1 do
      Sheet.Cells[1, iCount + 1] := TDBGrid(Args[I].VObject).Columns.Items[iCount].Title.Caption;    jCount := 1;
    while not TDBGrid(Args[I].VObject).DataSource.DataSet.Eof do
    begin
      for iCount := 0 to TDBGrid(Args[I].VObject).Columns.Count - 1 do
        Sheet.Cells[jCount + 1, iCount + 1] := TDBGrid(Args[I].VObject).Columns.Items[iCount].Field.AsString;      Inc(jCount);
      TDBGrid(Args[I].VObject).DataSource.DataSet.Next;
    end;
  end;  XlApp.Visible := True;
  Screen.Cursor := crDefault;
end;
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
经过测试，上面这段代码确实有问题：（有兴趣的朋友可以自己测试一下）比如：
先form1.CopyDbDataToExcel([dbgrid1,dbgrid2,dbgrid3]);//OK
再form1.CopyDbDataToExcel([dbgrid1,dbgrid2,dbgrid,dbgrid4]);//这样就出错，提示：无效索引如果这样：
先form1.CopyDbDataToExcel([dbgrid1,dbgrid2,dbgrid3,dbgrid4]);//OK
再form1.CopyDbDataToExcel([dbgrid1,dbgrid2]);//OK~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
总之：先多后少，就出错...
原因就出在上面代码（1），（2）两段上，经过测试,正确的应该将（1），（2）代码对调，才能保证不出错....