难题：希望有高手可以将下面的PAS文件修改，可以使导出到EXCEL的数据超过65536条 ( 积分: 83 )

各位朋友，PAS文件如下，当DBGridEh里面的内容超过65536条的时候，导出到EXCEL的时候就不正常，小弟想实现如下目的：将DBGridEh里面的内容导出到EXCEL的时候，超过6万条的，就自动导出到当前EXCEL文件的另外一个SHEET，如果当前的SHEET满了6万条，又继续导出到当前文件的另外一个SHEET，依次类推，使其导出的数据不局限于6万条记录左右，其实整个程序的难点就在于，如何判断当前的SHEET已经满，当前导出的记录已经导出到第几条，请问有没有大虾可以帮忙修改一下下面的PAS文件，使其可以实现上面的功能呢？

诚心向各位大虾求救，万分感谢！！！


unit U_DBGridEhToExcel;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, DB, ComCtrls, ExtCtrls, StdCtrls, Gauges, DBGridEh, ShellApi;
type
TTitleCell = array of array of string;
//分解DBGridEh的标题
TDBGridEhTitle = class
private
FDBGridEh: TDBGridEh; //对应DBGridEh
FColumnCount: integer; //DBGridEh列数(指visible为True的列数)
FRowCount: integer; //DBGridEh多表头层数(没有多表头则层数为1)
procedure SetDBGridEh(const Value: TDBGridEh);
function GetTitleRow: integer; //获取DBGridEh多表头层数
function GetTitleColumn: integer; //获取DBGridEh列数
public
//分解DBGridEh标题，由TitleCell二维动态数组返回
procedure GetTitleData(var TitleCell: TTitleCell);
published
property DBGridEh: TDBGridEh read FDBGridEh write SetDBGridEh;
property ColumnCount: integer read FColumnCount;
property RowCount: integer read FRowCount;
end;
TDBGridEhToExcel = class(TComponent)
private
FCol: integer;
FRow: integer;
FProgressForm: TForm; {进度窗体}
FGauge: TGauge; {进度条}
Stream: TStream; {输出文件流}
FBookMark: TBookmark;
FShowProgress: Boolean; {是否显示进度窗体}
FDBGridEh: TDBGridEh;
FBeginDate: TCaption; {开始日期}
FTitleName: TCaption; {Excel文件标题}
FEndDate: TCaption; {结束日期}
FUserName: TCaption; {制表人}
FFileName: string; {保存文件名}
procedure SetShowProgress(const Value: Boolean);
procedure SetDBGridEh(const Value: TDBGridEh);
procedure SetBeginDate(const Value: TCaption);
procedure SetEndDate(const Value: TCaption);
procedure SetTitleName(const Value: TCaption);
procedure SetUserName(const Value: TCaption);
procedure SetFileName(const Value: string);
procedure IncColRow;
procedure WriteBlankCell; {写空单元格}
{写数字单元格}
procedure WriteFloatCell(const AValue: Double; const IncStatus: Boolean = True);
{写整型单元格}
procedure WriteIntegerCell(const AValue: Integer; const IncStatus: Boolean = True);
{写字符单元格}
procedure WriteStringCell(const AValue: string; const IncStatus: Boolean = True);
procedure WritePrefix;
procedure WriteSuffix;
procedure WriteHeader; {输出Excel标题}
procedure WriteTitle; {输出Excel列标题}
procedure WriteDataCell; {输出数据集内容}
procedure WriteFooter; {输出DBGridEh表脚}
procedure SaveStream(aStream: TStream);
procedure CreateProcessForm(AOwner: TComponent); {生成进度窗体}
{根据表格修改数据集字段顺序及字段中文标题}
procedure SetDataSetCrossIndexDBGridEh;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure ExportToExcel; {输出Excel文件}
published
property DBGridEh: TDBGridEh read FDBGridEh write SetDBGridEh;
property ShowProgress: Boolean read FShowProgress write SetShowProgress;
property TitleName: TCaption read FTitleName write SetTitleName;
property BeginDate: TCaption read FBeginDate write SetBeginDate;
property EndDate: TCaption read FEndDate write SetEndDate;
property UserName: TCaption read FUserName write SetUserName;
property FileName: string read FFileName write SetFileName;
end;
var
CXlsBof: array[0..5] of Word = ($809, 8, 0, $10, 0, 0);
CXlsEof: array[0..1] of Word = ($0A, 00);
CXlsLabel: array[0..5] of Word = ($204, 0, 0, 0, 0, 0);
CXlsNumber: array[0..4] of Word = ($203, 14, 0, 0, 0);
CXlsRk: array[0..4] of Word = ($27E, 10, 0, 0, 0);
CXlsBlank: array[0..4] of Word = ($201, 6, 0, 0, $17);
implementation
{ TDBGridEhTitle }

function TDBGridEhTitle.GetTitleColumn: integer;
var
i, ColumnCount: integer;
begin
ColumnCount := 0;
for i := 0 to DBGridEh.Columns.Count - 1 do
begin
if DBGridEh.Columns.Visible then
Inc(ColumnCount);
end;
Result := ColumnCount;
end;

procedure TDBGridEhTitle.GetTitleData(var TitleCell: TTitleCell);
var
i, Row, Col: integer;
Caption: string;
begin
FColumnCount := GetTitleColumn;
FRowCount := GetTitleRow;
SetLength(TitleCell, FColumnCount, FRowCount);
Row := 0;
for i := 0 to DBGridEh.Columns.Count - 1 do
begin
if DBGridEh.Columns.Visible then
begin
Col := 0;
Caption := DBGridEh.Columns.Title.Caption;
while POS('|', Caption) > 0 do
begin
TitleCell[Row, Col] := Copy(Caption, 1, Pos('|', Caption) - 1);
Caption := Copy(Caption, Pos('|', Caption) + 1, Length(Caption));
Inc(Col);
end;
TitleCell[Row, Col] := Caption;
Inc(Row);
end;
end;
end;

function TDBGridEhTitle.GetTitleRow: integer;
var
i, j: integer;
MaxRow, Row: integer;
begin
MaxRow := 1;
for i := 0 to DBGridEh.Columns.Count - 1 do
begin
Row := 1;
for j := 0 to Length(DBGridEh.Columns.Title.Caption) do
begin
if DBGridEh.Columns.Title.Caption[j] = '|' then
Inc(Row);
end;
if MaxRow < Row then
MaxRow := Row;
end;
Result := MaxRow;
end;

procedure TDBGridEhTitle.SetDBGridEh(const Value: TDBGridEh);
begin
FDBGridEh := Value;
end;
{ TDBGridEhToExcel }

constructor TDBGridEhToExcel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FShowProgress := True;
end;

procedure TDBGridEhToExcel.SetShowProgress(const Value: Boolean);
begin
FShowProgress := Value;
end;

procedure TDBGridEhToExcel.SetDBGridEh(const Value: TDBGridEh);
begin
FDBGridEh := Value;
end;

procedure TDBGridEhToExcel.SetBeginDate(const Value: TCaption);
begin
FBeginDate := Value;
end;

procedure TDBGridEhToExcel.SetEndDate(const Value: TCaption);
begin
FEndDate := Value;
end;

procedure TDBGridEhToExcel.SetTitleName(const Value: TCaption);
begin
FTitleName := Value;
end;

procedure TDBGridEhToExcel.SetUserName(const Value: TCaption);
begin
FUserName := Value;
end;

procedure TDBGridEhToExcel.SetFileName(const Value: string);
begin
FFileName := Value;
end;

procedure TDBGridEhToExcel.IncColRow;
begin
if FCol = DBGridEh.DataSource.DataSet.FieldCount - 1 then
begin
Inc(FRow);
FCol := 0;
end
else
Inc(FCol);
end;

procedure TDBGridEhToExcel.WriteBlankCell;
begin
CXlsBlank[2] := FRow;
CXlsBlank[3] := FCol;
Stream.WriteBuffer(CXlsBlank, SizeOf(CXlsBlank));
IncColRow;
end;

procedure TDBGridEhToExcel.WriteFloatCell(const AValue: Double; const IncStatus: Boolean = True);
begin
CXlsNumber[2] := FRow;
CXlsNumber[3] := FCol;
Stream.WriteBuffer(CXlsNumber, SizeOf(CXlsNumber));
Stream.WriteBuffer(AValue, 8);
if IncStatus then
IncColRow;
end;

procedure TDBGridEhToExcel.WriteIntegerCell(const AValue: Integer; const IncStatus: Boolean = True);
var
V: Integer;
begin
CXlsRk[2] := FRow;
CXlsRk[3] := FCol;
Stream.WriteBuffer(CXlsRk, SizeOf(CXlsRk));
V := (AValue shl 2) or 2;
Stream.WriteBuffer(V, 4);
if IncStatus then
IncColRow;
end;

procedure TDBGridEhToExcel.WriteStringCell(const AValue: string; const IncStatus: Boolean = True);
var
L: integer;
begin
L := Length(AValue);
CXlsLabel[1] := 8 + L;
CXlsLabel[2] := FRow;
CXlsLabel[3] := FCol;
CXlsLabel[5] := L;
Stream.WriteBuffer(CXlsLabel, SizeOf(CXlsLabel));
Stream.WriteBuffer(Pointer(AValue)^, L);
if IncStatus then
IncColRow;
end;

procedure TDBGridEhToExcel.WritePrefix;
begin
Stream.WriteBuffer(CXlsBof, SizeOf(CXlsBof));
end;

procedure TDBGridEhToExcel.WriteSuffix;
begin
Stream.WriteBuffer(CXlsEof, SizeOf(CXlsEof));
end;

procedure TDBGridEhToExcel.WriteHeader;
var
OpName, OpDate: string;
begin
//标题
FCol := 3;
WriteStringCell(TitleName, False);
FCol := 0;
Inc(FRow);
if Trim(BeginDate) <> '' then
begin
//开始日期
FCol := 0;
WriteStringCell(BeginDate, False);
FCol := 0
end;
if Trim(EndDate) <> '' then
begin
//结束日期
FCol := 5;
WriteStringCell(EndDate, False);
FCol := 0;
end;
if (Trim(BeginDate) <> '') or (Trim(EndDate) <> '') then
Inc(FRow);
//制表人
OpName := '制表人：' + UserName;
FCol := 0;
WriteStringCell(OpName, False);
FCol := 0;
//制表时间
OpDate := '制表时间：' + DateTimeToStr(Now);
FCol := 5;
WriteStringCell(OpDate, False);
FCol := 0;
Inc(FRow);
end;

procedure TDBGridEhToExcel.WriteTitle;
var
i, j: integer;
DBGridEhTitle: TDBGridEhTitle;
TitleCell: TTitleCell;
begin
DBGridEhTitle := TDBGridEhTitle.Create;
try
DBGridEhTitle.DBGridEh := FDBGridEh;
DBGridEhTitle.GetTitleData(TitleCell);
try
for i := 0 to DBGridEhTitle.RowCount - 1 do
begin
for j := 0 to DBGridEhTitle.ColumnCount - 1 do
begin
FCol := j;
WriteStringCell(TitleCell[j, i], False);
end;
Inc(FRow);
end;
FCol := 0;
except
end;
finally
DBGridEhTitle.Free;
end;
end;

procedure TDBGridEhToExcel.WriteDataCell;
var
i: integer;
begin
DBGridEh.DataSource.DataSet.DisableControls;
FBookMark := DBGridEh.DataSource.DataSet.GetBookmark;
try
DBGridEh.DataSource.DataSet.First;
while not DBGridEh.DataSource.DataSet.Eof do
begin
for i := 0 to DBGridEh.DataSource.DataSet.FieldCount - 1 do
begin
if DBGridEh.DataSource.DataSet.Fields.IsNull or (not DBGridEh.DataSource.DataSet.Fields.Visible) then
WriteBlankCell
else
begin
case DBGridEh.DataSource.DataSet.Fields.DataType of
ftSmallint, ftInteger, ftWord, ftAutoInc, ftBytes:
WriteIntegerCell(DBGridEh.DataSource.DataSet.Fields.AsInteger);
ftFloat, ftCurrency, ftBCD:
WriteFloatCell(DBGridEh.DataSource.DataSet.Fields.AsFloat);
else
if DBGridEh.DataSource.DataSet.Fields is TBlobfield then // 此类型的字段(图像等)暂无法读取显示
WriteStringCell('')
else
WriteStringCell(DBGridEh.DataSource.DataSet.Fields.AsString);
end;
end;
end;
//显示进度条进度过程
if ShowProgress then
begin
FGauge.Progress := DBGridEh.DataSource.DataSet.RecNo;
FGauge.Refresh;
end;
DBGridEh.DataSource.DataSet.Next;
end;
finally
if DBGridEh.DataSource.DataSet.BookmarkValid(FBookMark) then
DBGridEh.DataSource.DataSet.GotoBookmark(FBookMark);
DBGridEh.DataSource.DataSet.EnableControls;
end;
end;

procedure TDBGridEhToExcel.WriteFooter;
var
i, j: integer;
begin
if DBGridEh.FooterRowCount = 0 then exit;
FCol := 0;
if DBGridEh.FooterRowCount = 1 then
begin
for i := 0 to DBGridEh.Columns.Count - 1 do
begin
if DBGridEh.Columns.Visible then
begin
WriteStringCell(DBGridEh.Columns.Footer.Value, False);
Inc(FCol);
end;
end;
end
else if DBGridEh.FooterRowCount > 1 then
begin
for i := 0 to DBGridEh.Columns.Count - 1 do
begin
if DBGridEh.Columns.Visible then
begin
for j := 0 to DBGridEh.Columns.Footers.Count - 1 do
begin
WriteStringCell(DBGridEh.Columns.Footers[j].Value, False);
Inc(FRow);
end;
Inc(FCol);
FRow := FRow - DBGridEh.Columns.Footers.Count;
end;
end;
end;
FCol := 0;
end;

procedure TDBGridEhToExcel.SaveStream(aStream: TStream);
begin
FCol := 0;
FRow := 0;
Stream := aStream;
//输出前缀
WritePrefix;
//输出表格标题
WriteHeader;
//输出列标题
WriteTitle;
//输出数据集内容
WriteDataCell;
//输出DBGridEh表脚
WriteFooter;
//输出后缀
WriteSuffix;
end;

procedure TDBGridEhToExcel.ExportToExcel;
var
FileStream: TFileStream;
Msg: string;
begin
//如果数据集为空或没有打开则退出
if (DBGridEh.DataSource.DataSet.IsEmpty) or (not DBGridEh.DataSource.DataSet.Active) then
exit;
//如果保存的文件名为空则退出
if Trim(FileName) = '' then
exit;

//根据表格修改数据集字段顺序及字段中文标题
SetDataSetCrossIndexDBGridEh;
Screen.Cursor := crHourGlass;
try
try
if FileExists(FileName) then
begin
Msg := '已存在文件（' + FileName + '），是否覆盖？';
if Application.MessageBox(PChar(Msg), '提示', MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2) = IDYES then
begin
//删除文件
DeleteFile(FileName)
end
else
exit;
end;
//显示进度窗体
if ShowProgress then
CreateProcessForm(nil);

FileStream := TFileStream.Create(FileName, fmCreate);
try
//输出文件
SaveStream(FileStream);
finally
FileStream.Free;
end;

//打开Excel文件
ShellExecute(0, 'Open', PChar(FileName), nil, nil, SW_SHOW);
except
end;
finally
if ShowProgress then
FreeAndNil(FProgressForm);
Screen.Cursor := crDefault;
end;
end;

destructor TDBGridEhToExcel.Destroy;
begin
inherited Destroy;
end;

procedure TDBGridEhToExcel.CreateProcessForm(AOwner: TComponent);
var
Panel: TPanel;
Prompt: TLabel; {提示的标签}
begin
if Assigned(FProgressForm) then
exit;
FProgressForm := TForm.Create(AOwner);
with FProgressForm do
begin
try
Font.Name := '宋体'; {设置字体}
Font.Size := 9;
BorderStyle := bsNone;
Width := 300;
Height := 100;
BorderWidth := 1;
Color := clBlack;
Position := poScreenCenter;
Panel := TPanel.Create(FProgressForm);
with Panel do
begin
Parent := FProgressForm;
Align := alClient;
BevelInner := bvNone;
BevelOuter := bvRaised;
Caption := '';
end;
Prompt := TLabel.Create(Panel);
with Prompt do
begin
Parent := Panel;
AutoSize := True;
Left := 25;
Top := 25;
Caption := '正在导出数据，请稍候......';
Font.Style := [fsBold];
end;
FGauge := TGauge.Create(Panel);
with FGauge do
begin
Parent := Panel;
ForeColor := clBlue;
Left := 20;
Top := 50;
Height := 13;
Width := 260;
MinValue := 0;
MaxValue := DBGridEh.DataSource.DataSet.RecordCount;
end;
except
end;
end;
FProgressForm.Show;
FProgressForm.Update;
end;

procedure TDBGridEhToExcel.SetDataSetCrossIndexDBGridEh;
var
i: integer;
begin
for i := 0 to DBGridEh.Columns.Count - 1 do
begin
DBGridEh.DataSource.DataSet.FieldByName(DBGridEh.Columns.Items.FieldName).Index := i;
DBGridEh.DataSource.DataSet.FieldByName(DBGridEh.Columns.Items.FieldName).DisplayLabel
:= DBGridEh.Columns.Items.Title.Caption;
DBGridEh.DataSource.DataSet.FieldByName(DBGridEh.Columns.Items.FieldName).Visible :=
DBGridEh.Columns.Items.Visible;
end;
for i := 0 to DBGridEh.DataSource.DataSet.FieldCount - 1 do
begin
if POS('*****', DBGridEh.DataSource.DataSet.Fields.DisplayLabel) > 0 then
DBGridEh.DataSource.DataSet.Fields.Visible := False;
end;
end;
end.

太长,没耐心看.

你的代码我就不看了，给你个DBGrid的吧，其实也不难，稍加改动就可以了
unit XlsFileUnit;

interface

uses
Windows,Messages,SysUtils,Classes,Graphics,Controls,Grids,Forms,
Dialogs,db,dbctrls,DBGrids,ComObj,Variants,Excel2000, OleServer;
const
{BOF}
CBOF =$0009;
BIT_BIFF5 = $0800;
BOF_BIFF5 = CBOF or BIT_BIFF5;
{EOF}
BIFF_EOF = $000a;
{Document types}
DOCTYPE_XLS = $0010;
{Dimensions}
DIMENSIONS = $0000;

c_maxCols=100;
c_maxRows=65534;
type
TAtributCell = (acHidden,acLocked,acShaded,acBottomBorder,acTopBorder,
acRightBorder,acLeftBorder,acLeft,acCenter,acRight,acFill);

TSetOfAtribut = set of TatributCell;

TXLSWriter = class(Tobject)
private
FStream:TFileStream;
procedure WriteWord(w:word);
protected
procedure WriteBOF;
procedure WriteEOF;
procedure WriteDimension;
public
maxCols,maxRows:Word;
procedure CellWord(vCol,vRow:word;aValue:word;vAtribut:TSetOfAtribut=[]);
procedure CellDouble(vCol,vRow:word;aValue:double;vAtribut:TSetOfAtribut=[]);
procedure CellStr(vCol,vRow:word;aValue:String;vAtribut:TSetOfAtribut=[]);
procedure WriteField(vCol,vRow:word;Field:TField);
constructor create(vFileName:string);
destructor destroy;override;
end;

procedure SetCellAtribut(value:TSetOfAtribut;var FAtribut:array of byte);
procedure DataSetToXLS(ds:TDataSet;fname:String;XLSList:TStrings=nil);
procedure DBgridToXLS(dbgrid:TDBGrid;fname:String;collist:TStrings=nil;XLSList:TStrings=nil); // collist.addobject('FieldName',tobject(Caption))
procedure StringGridToXLS(grid:TStringGrid;fname:String;XLSList:TStrings=nil);
procedure UniteXLSFiles(XLSFileNames:TStrings;DelOtherExl:Boolean = false); //合并多个excel文件
implementation

procedure DataSetToXLS(ds:TDataSet;fname:String;XLSList:TStrings);
var
c,r,x,i:Integer;
xls:TXLSWriter;
NewName,dir:string;
begin
if XLSList<>nil then
XLSList.Clear;
ds.first;
x:=ds.RecordCount div c_maxRows;
if ds.RecordCount mod c_maxRows >0 then inc(x);
for i:= 1 to x do
begin
if i>1 then
begin
dir := ExtractFileDir(fname);
NewName := ExtractFileName(fname);
NewName := copy(NewName,1,pos('.',NewName)-1)+inttostr(i)+'.xls';
end
else
NewName:=fname;
xls:=TXLSWriter.create(NewName);
if ds.FieldCount > xls.maxcols then
xls.maxcols:=ds.fieldcount+1;
try
xls.writeBOF;
xls.WriteDimension;
for c:=0 to ds.FieldCount-1 do
xls.Cellstr(0,c,ds.Fields[c].DisplayLabel);
r:=1;
while (not ds.eof) and (r <= xls.maxrows) do
begin
for c:=0 to ds.FieldCount-1 do
if ds.Fields[c].AsString<>'' then
xls.WriteField(r,c,ds.Fields[c]);
inc(r);
ds.next;
end;
xls.writeEOF;
if XLSList<>nil then
XLSList.Add(NewName) ;
finally
xls.free;
end;
end; //for
end;

procedure DBgridToXLS(dbgrid:TDBGrid;fname:String;collist:TStrings;XLSList:TStrings); // collist.addobject('FieldName',tobject(Caption))
var
c,r,x,i:Integer;
xls:TXLSWriter;
NewName,dir:string;
stringlist:TStringList;
titlelist:TStringList;
begin
if XLSList<>nil then
XLSList.Clear;
dbgrid.DataSource.DataSet.DisableControls;
dbgrid.DataSource.DataSet.First;
x:=dbgrid.DataSource.DataSet.RecordCount div c_maxRows;
if dbgrid.DataSource.DataSet.RecordCount mod c_maxRows >0 then inc(x);
for i:= 1 to x do
begin
if i>1 then
begin
dir := ExtractFileDir(fname);
NewName := ExtractFileName(fname);
NewName := copy(NewName,1,pos('.',NewName)-1)+inttostr(i)+'.xls';
end
else
NewName:=fname;
xls:=TXLSWriter.create(NewName);
stringlist := TStringList.Create;
titlelist := TStringList.Create;
if collist=nil then
begin
for c:=0 to dbgrid.Columns.Count-1 do
begin
if dbgrid.Columns[c].Visible = true then
begin
stringlist.Append(dbgrid.Columns[c].FieldName);
titlelist.Append(dbgrid.Columns[c].Title.Caption);
end;
end;
end
else
begin
for c:=0 to collist.Count-1 do
begin
stringlist.Append(collist.Strings[c]);
titlelist.Append(string(collist.Objects[c]));
end;
end;

if stringlist.Count > xls.maxcols then
xls.maxcols:=stringlist.Count+1;
try
xls.writeBOF;
xls.WriteDimension;
for c:=0 to stringlist.Count -1 do
xls.Cellstr(0,c,titlelist[c]);
r:=1;

while (not dbgrid.DataSource.DataSet.eof) and (r <= xls.maxrows) do
begin
for c:=0 to stringlist.Count -1 do
if dbgrid.DataSource.DataSet.FieldByName(stringlist[c]).AsString<>'' then
xls.WriteField(r,c,dbgrid.DataSource.DataSet.FieldByName(stringlist[c]));
inc(r);
dbgrid.DataSource.DataSet.next;
end;
xls.writeEOF;
if XLSList<>nil then
XLSList.Add(NewName);
finally
FreeAndNil(titlelist);
FreeAndNil(stringlist);
xls.free;
dbgrid.DataSource.DataSet.EnableControls;
end;
end; //for
end;

procedure StringGridToXLS(grid:TStringGrid;fname:String;XLSList:TStrings);
var
c,r,rMax:Integer;
xls:TXLSWriter;
begin
xls:=TXLSWriter.create(fname);
rMax:=grid.RowCount;
if grid.ColCount > xls.maxcols then
xls.maxcols:=grid.ColCount+1;
if rMax > xls.maxrows then // &amp;brvbar;&amp;sup1;&amp;reg;&amp;aelig;&amp;brvbar;&amp;iexcl;&amp;sup3;&amp;Igrave;&amp;brvbar;h&amp;yen;u&amp;macr;à&amp;brvbar;s 65535 Rows
rMax:=xls.maxrows;
try
xls.writeBOF;
xls.WriteDimension;
for c:=0 to grid.ColCount-1 do
for r:=0 to rMax-1 do
xls.Cellstr(r,c,grid.Cells[c,r]);
xls.writeEOF;
finally
xls.free;
end;
end;

{ TXLSWriter }

constructor TXLSWriter.create(vFileName:string);
begin
inherited create;
if FileExists(vFilename) then
fStream:=TFileStream.Create(vFilename,fmOpenWrite)
else
fStream:=TFileStream.Create(vFilename,fmCreate);

maxCols:=c_maxCols; // <2002-11-17> dllee Column &amp;Agrave;&amp;sup3;&amp;cedil;&amp;Oacute;&amp;not;O¤&amp;pound;&amp;yen;i&amp;macr;à¤j&amp;copy;ó 65535, &amp;copy;&amp;Ograve;&amp;yen;H¤&amp;pound;&amp;brvbar;A&amp;sup3;B&amp;sup2;z
maxRows:=c_maxRows; // <2002-11-17> dllee &amp;sup3;o&amp;shy;&amp;Oacute;&amp;reg;&amp;aelig;&amp;brvbar;&amp;iexcl;&amp;sup3;&amp;Igrave;¤j&amp;yen;u&amp;macr;à&amp;sup3;o&amp;raquo;ò¤j&amp;iexcl;A&amp;frac12;&amp;ETH;&amp;ordf;`·N¤j&amp;ordf;&amp;ordm;&amp;cedil;ê&amp;reg;&amp;AElig;&amp;reg;w&amp;laquo;&amp;Uuml;&amp;reg;e&amp;copy;&amp;ouml;&amp;acute;N¤j&amp;copy;ó&amp;sup3;o&amp;shy;&amp;Oacute;&amp;shy;&amp;Egrave;
end;

destructor TXLSWriter.destroy;
begin
if fStream <> nil then
fStream.free;
inherited;
end;

procedure TXLSWriter.WriteBOF;
begin
Writeword(BOF_BIFF5);
Writeword(6); // count of bytes
Writeword(0);
Writeword(DOCTYPE_XLS);
Writeword(0);
end;

procedure TXLSWriter.WriteDimension;
begin
Writeword(DIMENSIONS); // dimension OP Code
Writeword(8); // count of bytes
Writeword(0); // min cols
Writeword(maxRows); // max rows
Writeword(0); // min rowss
Writeword(maxcols); // max cols
end;

procedure TXLSWriter.CellDouble(vCol, vRow: word; aValue: double;
vAtribut: TSetOfAtribut);
var FAtribut:array [0..2] of byte;
begin
Writeword(3); // opcode for double
Writeword(15); // count of byte
Writeword(vCol);
Writeword(vRow);
SetCellAtribut(vAtribut,fAtribut);
fStream.Write(fAtribut,3);
fStream.Write(aValue,8);
end;

procedure TXLSWriter.CellWord(vCol,vRow:word;aValue:word;vAtribut:TSetOfAtribut=[]);
var FAtribut:array [0..2] of byte;
begin
Writeword(2); // opcode for word
Writeword(9); // count of byte
Writeword(vCol);
Writeword(vRow);
SetCellAtribut(vAtribut,fAtribut);
fStream.Write(fAtribut,3);
Writeword(aValue);
end;

procedure TXLSWriter.CellStr(vCol, vRow: word; aValue: String;
vAtribut: TSetOfAtribut);
var
FAtribut:array [0..2] of byte;
slen:byte;
begin
Writeword(4); // opcode for string
slen:=length(avalue);
Writeword(slen+8); // count of byte
Writeword(vCol);
Writeword(vRow);
SetCellAtribut(vAtribut,fAtribut);
fStream.Write(fAtribut,3);
fStream.Write(slen,1);
fStream.Write(aValue[1],slen);
end;

procedure SetCellAtribut(value:TSetOfAtribut;var FAtribut:array of byte);
var
i:integer;
begin
//reset
for i:=0 to High(FAtribut) do
FAtribut:=0;

if acHidden in value then //byte 0 bit 7:
FAtribut[0] := FAtribut[0] + 128;

if acLocked in value then //byte 0 bit 6:
FAtribut[0] := FAtribut[0] + 64 ;

if acShaded in value then //byte 2 bit 7:
FAtribut[2] := FAtribut[2] + 128;

if acBottomBorder in value then //byte 2 bit 6
FAtribut[2] := FAtribut[2] + 64 ;

if acTopBorder in value then //byte 2 bit 5
FAtribut[2] := FAtribut[2] + 32;

if acRightBorder in value then //byte 2 bit 4
FAtribut[2] := FAtribut[2] + 16;

if acLeftBorder in value then //byte 2 bit 3
FAtribut[2] := FAtribut[2] + 8;

// <2002-11-17> dllee &amp;sup3;&amp;Igrave;&amp;laquo;á 3 bit &amp;Agrave;&amp;sup3;&amp;yen;u&amp;brvbar;&amp;sup3; 1 &amp;ordm;&amp;Oslash;&amp;iquest;&amp;iuml;&amp;frac34;&amp;Uuml;
if acLeft in value then //byte 2 bit 1
FAtribut[2] := FAtribut[2] + 1
else if acCenter in value then //byte 2 bit 1
FAtribut[2] := FAtribut[2] + 2
else if acRight in value then //byte 2, bit 0 dan bit 1
FAtribut[2] := FAtribut[2] + 3
else if acFill in value then //byte 2, bit 0
FAtribut[2] := FAtribut[2] + 4;
end;

procedure TXLSWriter.WriteWord(w: word);
begin
fstream.Write(w,2);
end;

procedure TXLSWriter.WriteEOF;
begin
Writeword(BIFF_EOF);
Writeword(0);
end;

procedure TXLSWriter.WriteField(vCol, vRow: word; Field: TField);
begin
case field.DataType of
ftString,ftWideString,ftBoolean,ftDate,ftDateTime,ftTime:
Cellstr(vcol,vrow,field.asstring);
ftAutoInc,ftSmallint,ftInteger,ftWord:
CellWord(vcol,vRow,field.AsInteger);
ftFloat, ftBCD:
CellDouble(vcol,vrow,field.AsFloat);
else
Cellstr(vcol,vrow,EmptyStr); // <2002-11-17> dllee ¨&amp;auml;&amp;yen;L&amp;laquo;&amp;not;&amp;ordm;A&amp;frac14;g¤J&amp;ordf;&amp;Aring;&amp;yen;&amp;Otilde;&amp;brvbar;r&amp;brvbar;ê
end;
end;
procedure UniteXLSFiles(XLSFileNames:TStrings;DelOtherExl:Boolean = false); //合并多个excel文件
var
xlApp,NextXLApp,xlSheet,NextXLSheet,NewXLSheet,range: Variant;
i:integer;
begin
xlApp:=UnAssigned;
NextXLApp:=UnAssigned;
try
xlApp := CreateOleObject('Excel.Application');
xlApp.WorkBooks.Open(XLSFileNames[0]); //获取第一个excel文件
xlSheet:=xlApp.WorkBooks[1].WorkSheets[1]; //获取第一个Sheet
xlSheet.Name:='Sheet1';
xlApp.WorkBooks[1].save;
if XLSFileNames.Count <=1 then exit; //多于1个文件时才操作
for i:= 1 to XLSFileNames.Count -1 do
begin
try
NextXLApp := CreateOleObject('Excel.Application');
NextXLApp.WorkBooks.Open(XLSFileNames); //获取其他excel文件
NextXLApp.WorkSheets[1].Activate;
NextXLApp.ActiveSheet.UsedRange.Copy; //拷贝
NewXLSheet:=xlApp.WorkSheets.Add; //添加
NewXLSheet.PasteSpecial; //粘贴
xlApp.ActiveWorkBook.Save;
finally
NextXLApp.WorkBooks.Close;
NextXLApp.Quit;
NextXLApp := UnAssigned;
if DelOtherExl then
Deletefile(XLSFileNames);
end;
end;
finally
xlApp.WorkBooks.Close;
xlApp.Quit;
xlApp := UnAssigned;
end;
end;

end.

谢谢楼上两位大虾的热心回复，但诚心希望有耐心的大虾可以将自己写的代码进行修改，期待ING，谢谢：）

提问题也有这么牛的，你看看我的代码是怎么实现的，自己稍加修改就可以了。
下面是核心处理代码：
procedure DataSetToXLS(ds:TDataSet;fname:String;XLSList:TStrings);
var
c,r,x,i:Integer;
xls:TXLSWriter;
NewName,dir:string;
begin
if XLSList<>nil then
XLSList.Clear;
ds.first;
//判断需要多少个sheet
x:=ds.RecordCount div c_maxRows;
if ds.RecordCount mod c_maxRows >0 then inc(x);
//为每个sheet赋数据
for i:= 1 to x do
begin
//生成后续xls文件名
if i>1 then
begin
dir := ExtractFileDir(fname);
NewName := ExtractFileName(fname);
NewName := copy(NewName,1,pos('.',NewName)-1)+inttostr(i)+'.xls';
end
else
NewName:=fname;
xls:=TXLSWriter.create(NewName);
if ds.FieldCount > xls.maxcols then
xls.maxcols:=ds.fieldcount+1;
try
xls.writeBOF;
xls.WriteDimension;
for c:=0 to ds.FieldCount-1 do
xls.Cellstr(0,c,ds.Fields[c].DisplayLabel);
r:=1; //行数从1开始，每个外循环都初始此值
//当数据没有结束和没有达到最大行时做
while (not ds.eof) and (r <= xls.maxrows) do
begin
for c:=0 to ds.FieldCount-1 do
if ds.Fields[c].AsString<>'' then
xls.WriteField(r,c,ds.Fields[c]);
inc(r);
ds.next;
end;
xls.writeEOF;
if XLSList<>nil then //保存xls文件名
XLSList.Add(NewName) ;
finally
xls.free;
end;
end; //for
end;
//到处完毕的文件是单个的xls文件，把他们合并到第一个文件中就可以了,合并多个excel文件
procedure UniteXLSFiles(XLSFileNames:TStrings;DelOtherExl:Boolean = false);
var
xlApp,NextXLApp,xlSheet,NextXLSheet,NewXLSheet,range: Variant;
i:integer;
begin
xlApp:=UnAssigned;
NextXLApp:=UnAssigned;
try
xlApp := CreateOleObject('Excel.Application');
xlApp.WorkBooks.Open(XLSFileNames[0]); //获取第一个excel文件
xlSheet:=xlApp.WorkBooks[1].WorkSheets[1]; //获取第一个Sheet
xlSheet.Name:='Sheet1';
xlApp.WorkBooks[1].save;
if XLSFileNames.Count <=1 then exit; //多于1个文件时才操作
for i:= 1 to XLSFileNames.Count -1 do
begin
try
NextXLApp := CreateOleObject('Excel.Application');
NextXLApp.WorkBooks.Open(XLSFileNames); //获取其他excel文件
NextXLApp.WorkSheets[1].Activate;
NextXLApp.ActiveSheet.UsedRange.Copy; //拷贝
NewXLSheet:=xlApp.WorkSheets.Add; //添加
NewXLSheet.PasteSpecial; //粘贴
xlApp.ActiveWorkBook.Save;
finally
NextXLApp.WorkBooks.Close;
NextXLApp.Quit;
NextXLApp := UnAssigned;
if DelOtherExl then
Deletefile(XLSFileNames);
end;
end;
finally
xlApp.WorkBooks.Close;
xlApp.Quit;
xlApp := UnAssigned;
end;
end;

这是个思路，你可以改你的程序了，但是你让别人该你的代码，恐怕要看看人家有没有时间了。

楼上的大虾，谢谢热心回复，确实看别人的代码是一件很疼苦的事情，小弟决定再花一个星期的时间再去研究一下，无论如何，都要将自己的东西改好，谢谢您啊，呵呵 ～～

哎,何必呢,以上楼主的方案很好啊.

结贴，谢谢楼上的各位朋友！

多人接受答案了。