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

[gxgyj]

http://dev.csdn.net/article/53/53442.shtm
如何将几个DBGRID里的内容导入同一个EXCEL表中？
在软件实际制作中，为节省开发成本和开发周期，一些软件人员通常会吧DBGrid中的数据直接导出到Excel表中，而先前能看到的函数仅仅只能在WorkBook的一个Sheet中导入数据，不支持多Sheet！。

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

unit Unit1;

interface

uses
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的例子...有没有碰到这种情况...还请各位指点一下...^_^

[gxgyj]

自己顶.....

[gxgyj]

怎么没有人帮我????

[fhuibo]

刚写的把多个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;

[gxgyj]

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

[gxgyj]

或者，哪位有更好的...
等待.......

[web700]

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

[gxgyj]

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才能继续运行程序，不提示'效索引'个错误...

￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣￣
请各位大侠看看如何才能不出现这种情况.........(如不够可以加)( 或者，哪位有更好的，也请您指点一下)....谢谢啦...^_^

[muleo]

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

[yuanscar]

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

[yuanscar]

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

[gxgyj]

最后自己发现了问题出在哪里了，经过几番测试，解决了...
谢谢楼上几位

[gxgyj]

刚写的把多个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）代码对调，才能保证不出错....

[gxgyj]

应该是：先少后多，就出错...

[fengxue291080]

循环直接给EXCEL赋值

[gxgyj]

继续...

[Sorder]

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