怎么把 把 DBGRID (不是 StringGrid1) 里的数据倒入到 EXCEL 。
要用流的形式!
6 个解决方案
#1
为什么要用流的形式呢?
#2
.
#3
fengzhengren 大哥:
您好!
他们说流快一些啊!
您好!
他们说流快一些啊!
#4
ExportToExcel(DBGGrid1.Datasource)
//自已寫的,有些地方還不如意,如導出時界面上的字看不見。請大家改正,
procedure ExportToExcel(SourceData: TDataSource);
var
ExcelApp:TExcelApplication;
ExcelWkbook:TExcelWorkBook;
ExcelWkSheet:TExcelWorkSheet;
i,j,Rcount,CurReNo:integer;
Savefilename:TSaveDialog;
filename:string;
f_progress:Tform;
cLabel:TLabel;
cProgressBar:TProgressBar;
begin
if SourceData.DataSet.RecordCount>65000 then begin
Showmessage('癸ぃ癬讽玡い计誹癘魁65000Excel既ぃや');
exit;
end;
Savefilename:=TSaveDialog.Create(nil);
SaveFilename.Filter:='Excel files (*.xls)|*.xls';
if not SaveFilename.Execute then Begin
SaveFileName.Free;
exit;
End;
filename:=SaveFilename.FileName;
Savefilename.Free;
Try
ExcelApp:=TExcelApplication.Create(nil);
ExcelWkbook:=TExcelWorkBook.Create(nil);
ExcelWkSheet:=TExcelWorkSheet.Create(nil);
ExcelApp.Connect;
Except
Showmessage(' Excel not Install');
Abort;
end;
f_progress:=Tform.Create(Application);
with f_progress do begin
Caption:='秈';
BorderStyle:=bsDialog;
Position:=poMainFormCenter;
width:=393;
height:=106;
end;
cLabel:=Tlabel.Create(f_progress);
with clabel do begin
name:='label1';
Parent:=f_progress;
Font.Color:=clBlue;
Font.size:=14;
Caption:='计誹矪瞶い叫祔****';
Top:=8;
width:=205;
height:=24;
Left:=84;
end;
cProgressBar:=TProgressBar.create(f_progress);
with cProgressBar do begin
Name:='ProgressBar1';
// Parent:=f_progress;
Top:=48;
width:=336;
height:=22;
Left:=25;
end;
f_progress.Show;
cProgressBar.Position:=0;
ExcelApp.Workbooks.Add(EmptyParam,0);
ExcelWkBook.ConnectTo(ExcelApp.Workbooks[1]);
ExcelWksheet.ConnectTo(ExcelWkbook.Worksheets[1] as _worksheet);
Rcount:=SourceData.Dataset.RecordCount;
SourceData.Dataset.First;
SourceData.Dataset.DisableControls;
for i:=0 to SourceData.Dataset.FieldCount-1 do begin
ExcelwkSheet.Cells.Item[1,i+1]:=SourceData.Dataset.Fields[i].DisplayLabel;
end;
for j:=2 to Rcount+1 do begin
for i:=0 to SourceData.Dataset.FieldCount-1 do begin
ExcelwkSheet.Cells.Item[j,i+1]:=SourceData.Dataset.Fields[i].Value;
End;
SourceData.Dataset.Next;
CurReNo:=SourceData.Dataset.RecNo;
cProgressBar.Position:=Trunc(cProgressBar.Max*CurReNo / Rcount);
end;
ExcelwkSheet.Cells.Font.Size:='10';
ExcelwkSheet.Columns.AutoFit;
ExcelWkSheet.SaveAs(FileName);
SourceData.Dataset.EnableControls;
ExcelApp.Disconnect;
clabel.Free;
cProgressBar.Free;
f_progress.Free;
excelApp.Quit;
ExcelApp.Free;
Excelwkbook.Free;
ExcelwkSheet.Free;
Showmessage('计誹Θ旧ゅン'+filename);
//自已寫的,有些地方還不如意,如導出時界面上的字看不見。請大家改正,
procedure ExportToExcel(SourceData: TDataSource);
var
ExcelApp:TExcelApplication;
ExcelWkbook:TExcelWorkBook;
ExcelWkSheet:TExcelWorkSheet;
i,j,Rcount,CurReNo:integer;
Savefilename:TSaveDialog;
filename:string;
f_progress:Tform;
cLabel:TLabel;
cProgressBar:TProgressBar;
begin
if SourceData.DataSet.RecordCount>65000 then begin
Showmessage('癸ぃ癬讽玡い计誹癘魁65000Excel既ぃや');
exit;
end;
Savefilename:=TSaveDialog.Create(nil);
SaveFilename.Filter:='Excel files (*.xls)|*.xls';
if not SaveFilename.Execute then Begin
SaveFileName.Free;
exit;
End;
filename:=SaveFilename.FileName;
Savefilename.Free;
Try
ExcelApp:=TExcelApplication.Create(nil);
ExcelWkbook:=TExcelWorkBook.Create(nil);
ExcelWkSheet:=TExcelWorkSheet.Create(nil);
ExcelApp.Connect;
Except
Showmessage(' Excel not Install');
Abort;
end;
f_progress:=Tform.Create(Application);
with f_progress do begin
Caption:='秈';
BorderStyle:=bsDialog;
Position:=poMainFormCenter;
width:=393;
height:=106;
end;
cLabel:=Tlabel.Create(f_progress);
with clabel do begin
name:='label1';
Parent:=f_progress;
Font.Color:=clBlue;
Font.size:=14;
Caption:='计誹矪瞶い叫祔****';
Top:=8;
width:=205;
height:=24;
Left:=84;
end;
cProgressBar:=TProgressBar.create(f_progress);
with cProgressBar do begin
Name:='ProgressBar1';
// Parent:=f_progress;
Top:=48;
width:=336;
height:=22;
Left:=25;
end;
f_progress.Show;
cProgressBar.Position:=0;
ExcelApp.Workbooks.Add(EmptyParam,0);
ExcelWkBook.ConnectTo(ExcelApp.Workbooks[1]);
ExcelWksheet.ConnectTo(ExcelWkbook.Worksheets[1] as _worksheet);
Rcount:=SourceData.Dataset.RecordCount;
SourceData.Dataset.First;
SourceData.Dataset.DisableControls;
for i:=0 to SourceData.Dataset.FieldCount-1 do begin
ExcelwkSheet.Cells.Item[1,i+1]:=SourceData.Dataset.Fields[i].DisplayLabel;
end;
for j:=2 to Rcount+1 do begin
for i:=0 to SourceData.Dataset.FieldCount-1 do begin
ExcelwkSheet.Cells.Item[j,i+1]:=SourceData.Dataset.Fields[i].Value;
End;
SourceData.Dataset.Next;
CurReNo:=SourceData.Dataset.RecNo;
cProgressBar.Position:=Trunc(cProgressBar.Max*CurReNo / Rcount);
end;
ExcelwkSheet.Cells.Font.Size:='10';
ExcelwkSheet.Columns.AutoFit;
ExcelWkSheet.SaveAs(FileName);
SourceData.Dataset.EnableControls;
ExcelApp.Disconnect;
clabel.Free;
cProgressBar.Free;
f_progress.Free;
excelApp.Quit;
ExcelApp.Free;
Excelwkbook.Free;
ExcelwkSheet.Free;
Showmessage('计誹Θ旧ゅン'+filename);
#5
帮你顶
#6
********** 来自---- win2000pega(景) **************************
我现在几万条,不会超过20秒。
现在导48890条,1分13秒。
用文件流处理很快的。
代码如下:
unit UnitXLSFile;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Grids, Forms, Dialogs,db,dbctrls,comctrls;
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;
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);
procedure StringGridToXLS(grid:TStringGrid;fname:String);
implementation
procedure DataSetToXLS(ds:TDataSet;fname:String);
var c,r:Integer;
xls:TXLSWriter;
begin
xls:=TXLSWriter.create(fname);
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;
ds.first;
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;
finally
xls.free;
end;
end;
procedure StringGridToXLS(grid:TStringGrid;fname:String);
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 // ¦¹®æ¦¡³Ì¦h¥u¯à¦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:=100; // <2002-11-17> dllee Column À³¸Ó¬O¤£¥i¯à¤j©ó 65535, ©Ò¥H¤£¦A³B²z
maxRows:=65535; // <2002-11-17> dllee ³o­Ó®æ¦¡³Ì¤j¥u¯à³o»ò¤j¡A½Ðª`·N¤jªº¸ê®Æ®w«Ü®e©ö´N¤j©ó³o­Ó­È
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[i]:=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 ³Ì«á 3 bit À³¥u¦³ 1 ºØ¿ï¾Ü
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 ¨ä¥L«¬ºA¼g¤JªÅ¥Õ¦r¦ê
end;
end;
我现在几万条,不会超过20秒。
现在导48890条,1分13秒。
用文件流处理很快的。
代码如下:
unit UnitXLSFile;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Grids, Forms, Dialogs,db,dbctrls,comctrls;
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;
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);
procedure StringGridToXLS(grid:TStringGrid;fname:String);
implementation
procedure DataSetToXLS(ds:TDataSet;fname:String);
var c,r:Integer;
xls:TXLSWriter;
begin
xls:=TXLSWriter.create(fname);
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;
ds.first;
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;
finally
xls.free;
end;
end;
procedure StringGridToXLS(grid:TStringGrid;fname:String);
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 // ¦¹®æ¦¡³Ì¦h¥u¯à¦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:=100; // <2002-11-17> dllee Column À³¸Ó¬O¤£¥i¯à¤j©ó 65535, ©Ò¥H¤£¦A³B²z
maxRows:=65535; // <2002-11-17> dllee ³o­Ó®æ¦¡³Ì¤j¥u¯à³o»ò¤j¡A½Ðª`·N¤jªº¸ê®Æ®w«Ü®e©ö´N¤j©ó³o­Ó­È
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[i]:=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 ³Ì«á 3 bit À³¥u¦³ 1 ºØ¿ï¾Ü
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 ¨ä¥L«¬ºA¼g¤JªÅ¥Õ¦r¦ê
end;
end;
#1
为什么要用流的形式呢?
#2
.
#3
fengzhengren 大哥:
您好!
他们说流快一些啊!
您好!
他们说流快一些啊!
#4
ExportToExcel(DBGGrid1.Datasource)
//自已寫的,有些地方還不如意,如導出時界面上的字看不見。請大家改正,
procedure ExportToExcel(SourceData: TDataSource);
var
ExcelApp:TExcelApplication;
ExcelWkbook:TExcelWorkBook;
ExcelWkSheet:TExcelWorkSheet;
i,j,Rcount,CurReNo:integer;
Savefilename:TSaveDialog;
filename:string;
f_progress:Tform;
cLabel:TLabel;
cProgressBar:TProgressBar;
begin
if SourceData.DataSet.RecordCount>65000 then begin
Showmessage('癸ぃ癬讽玡い计誹癘魁65000Excel既ぃや');
exit;
end;
Savefilename:=TSaveDialog.Create(nil);
SaveFilename.Filter:='Excel files (*.xls)|*.xls';
if not SaveFilename.Execute then Begin
SaveFileName.Free;
exit;
End;
filename:=SaveFilename.FileName;
Savefilename.Free;
Try
ExcelApp:=TExcelApplication.Create(nil);
ExcelWkbook:=TExcelWorkBook.Create(nil);
ExcelWkSheet:=TExcelWorkSheet.Create(nil);
ExcelApp.Connect;
Except
Showmessage(' Excel not Install');
Abort;
end;
f_progress:=Tform.Create(Application);
with f_progress do begin
Caption:='秈';
BorderStyle:=bsDialog;
Position:=poMainFormCenter;
width:=393;
height:=106;
end;
cLabel:=Tlabel.Create(f_progress);
with clabel do begin
name:='label1';
Parent:=f_progress;
Font.Color:=clBlue;
Font.size:=14;
Caption:='计誹矪瞶い叫祔****';
Top:=8;
width:=205;
height:=24;
Left:=84;
end;
cProgressBar:=TProgressBar.create(f_progress);
with cProgressBar do begin
Name:='ProgressBar1';
// Parent:=f_progress;
Top:=48;
width:=336;
height:=22;
Left:=25;
end;
f_progress.Show;
cProgressBar.Position:=0;
ExcelApp.Workbooks.Add(EmptyParam,0);
ExcelWkBook.ConnectTo(ExcelApp.Workbooks[1]);
ExcelWksheet.ConnectTo(ExcelWkbook.Worksheets[1] as _worksheet);
Rcount:=SourceData.Dataset.RecordCount;
SourceData.Dataset.First;
SourceData.Dataset.DisableControls;
for i:=0 to SourceData.Dataset.FieldCount-1 do begin
ExcelwkSheet.Cells.Item[1,i+1]:=SourceData.Dataset.Fields[i].DisplayLabel;
end;
for j:=2 to Rcount+1 do begin
for i:=0 to SourceData.Dataset.FieldCount-1 do begin
ExcelwkSheet.Cells.Item[j,i+1]:=SourceData.Dataset.Fields[i].Value;
End;
SourceData.Dataset.Next;
CurReNo:=SourceData.Dataset.RecNo;
cProgressBar.Position:=Trunc(cProgressBar.Max*CurReNo / Rcount);
end;
ExcelwkSheet.Cells.Font.Size:='10';
ExcelwkSheet.Columns.AutoFit;
ExcelWkSheet.SaveAs(FileName);
SourceData.Dataset.EnableControls;
ExcelApp.Disconnect;
clabel.Free;
cProgressBar.Free;
f_progress.Free;
excelApp.Quit;
ExcelApp.Free;
Excelwkbook.Free;
ExcelwkSheet.Free;
Showmessage('计誹Θ旧ゅン'+filename);
//自已寫的,有些地方還不如意,如導出時界面上的字看不見。請大家改正,
procedure ExportToExcel(SourceData: TDataSource);
var
ExcelApp:TExcelApplication;
ExcelWkbook:TExcelWorkBook;
ExcelWkSheet:TExcelWorkSheet;
i,j,Rcount,CurReNo:integer;
Savefilename:TSaveDialog;
filename:string;
f_progress:Tform;
cLabel:TLabel;
cProgressBar:TProgressBar;
begin
if SourceData.DataSet.RecordCount>65000 then begin
Showmessage('癸ぃ癬讽玡い计誹癘魁65000Excel既ぃや');
exit;
end;
Savefilename:=TSaveDialog.Create(nil);
SaveFilename.Filter:='Excel files (*.xls)|*.xls';
if not SaveFilename.Execute then Begin
SaveFileName.Free;
exit;
End;
filename:=SaveFilename.FileName;
Savefilename.Free;
Try
ExcelApp:=TExcelApplication.Create(nil);
ExcelWkbook:=TExcelWorkBook.Create(nil);
ExcelWkSheet:=TExcelWorkSheet.Create(nil);
ExcelApp.Connect;
Except
Showmessage(' Excel not Install');
Abort;
end;
f_progress:=Tform.Create(Application);
with f_progress do begin
Caption:='秈';
BorderStyle:=bsDialog;
Position:=poMainFormCenter;
width:=393;
height:=106;
end;
cLabel:=Tlabel.Create(f_progress);
with clabel do begin
name:='label1';
Parent:=f_progress;
Font.Color:=clBlue;
Font.size:=14;
Caption:='计誹矪瞶い叫祔****';
Top:=8;
width:=205;
height:=24;
Left:=84;
end;
cProgressBar:=TProgressBar.create(f_progress);
with cProgressBar do begin
Name:='ProgressBar1';
// Parent:=f_progress;
Top:=48;
width:=336;
height:=22;
Left:=25;
end;
f_progress.Show;
cProgressBar.Position:=0;
ExcelApp.Workbooks.Add(EmptyParam,0);
ExcelWkBook.ConnectTo(ExcelApp.Workbooks[1]);
ExcelWksheet.ConnectTo(ExcelWkbook.Worksheets[1] as _worksheet);
Rcount:=SourceData.Dataset.RecordCount;
SourceData.Dataset.First;
SourceData.Dataset.DisableControls;
for i:=0 to SourceData.Dataset.FieldCount-1 do begin
ExcelwkSheet.Cells.Item[1,i+1]:=SourceData.Dataset.Fields[i].DisplayLabel;
end;
for j:=2 to Rcount+1 do begin
for i:=0 to SourceData.Dataset.FieldCount-1 do begin
ExcelwkSheet.Cells.Item[j,i+1]:=SourceData.Dataset.Fields[i].Value;
End;
SourceData.Dataset.Next;
CurReNo:=SourceData.Dataset.RecNo;
cProgressBar.Position:=Trunc(cProgressBar.Max*CurReNo / Rcount);
end;
ExcelwkSheet.Cells.Font.Size:='10';
ExcelwkSheet.Columns.AutoFit;
ExcelWkSheet.SaveAs(FileName);
SourceData.Dataset.EnableControls;
ExcelApp.Disconnect;
clabel.Free;
cProgressBar.Free;
f_progress.Free;
excelApp.Quit;
ExcelApp.Free;
Excelwkbook.Free;
ExcelwkSheet.Free;
Showmessage('计誹Θ旧ゅン'+filename);
#5
帮你顶
#6
********** 来自---- win2000pega(景) **************************
我现在几万条,不会超过20秒。
现在导48890条,1分13秒。
用文件流处理很快的。
代码如下:
unit UnitXLSFile;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Grids, Forms, Dialogs,db,dbctrls,comctrls;
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;
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);
procedure StringGridToXLS(grid:TStringGrid;fname:String);
implementation
procedure DataSetToXLS(ds:TDataSet;fname:String);
var c,r:Integer;
xls:TXLSWriter;
begin
xls:=TXLSWriter.create(fname);
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;
ds.first;
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;
finally
xls.free;
end;
end;
procedure StringGridToXLS(grid:TStringGrid;fname:String);
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 // ¦¹®æ¦¡³Ì¦h¥u¯à¦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:=100; // <2002-11-17> dllee Column À³¸Ó¬O¤£¥i¯à¤j©ó 65535, ©Ò¥H¤£¦A³B²z
maxRows:=65535; // <2002-11-17> dllee ³o­Ó®æ¦¡³Ì¤j¥u¯à³o»ò¤j¡A½Ðª`·N¤jªº¸ê®Æ®w«Ü®e©ö´N¤j©ó³o­Ó­È
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[i]:=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 ³Ì«á 3 bit À³¥u¦³ 1 ºØ¿ï¾Ü
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 ¨ä¥L«¬ºA¼g¤JªÅ¥Õ¦r¦ê
end;
end;
我现在几万条,不会超过20秒。
现在导48890条,1分13秒。
用文件流处理很快的。
代码如下:
unit UnitXLSFile;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Grids, Forms, Dialogs,db,dbctrls,comctrls;
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;
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);
procedure StringGridToXLS(grid:TStringGrid;fname:String);
implementation
procedure DataSetToXLS(ds:TDataSet;fname:String);
var c,r:Integer;
xls:TXLSWriter;
begin
xls:=TXLSWriter.create(fname);
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;
ds.first;
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;
finally
xls.free;
end;
end;
procedure StringGridToXLS(grid:TStringGrid;fname:String);
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 // ¦¹®æ¦¡³Ì¦h¥u¯à¦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:=100; // <2002-11-17> dllee Column À³¸Ó¬O¤£¥i¯à¤j©ó 65535, ©Ò¥H¤£¦A³B²z
maxRows:=65535; // <2002-11-17> dllee ³o­Ó®æ¦¡³Ì¤j¥u¯à³o»ò¤j¡A½Ðª`·N¤jªº¸ê®Æ®w«Ü®e©ö´N¤j©ó³o­Ó­È
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[i]:=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 ³Ì«á 3 bit À³¥u¦³ 1 ºØ¿ï¾Ü
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 ¨ä¥L«¬ºA¼g¤JªÅ¥Õ¦r¦ê
end;
end;