请问各位,如何Delphi实现快速将数据导出为EXECEL,我在书上按传统的方法不是很好,数据太多就速度较慢
解决方案 »
- 我是新手,请问一个记录集指针的难道(相对我来说)
- 不耻下问:如何组织一个中小型的delphi项目?送全部的分,舍不得孩子套不来狼啊。
- 传递datetime型数据出错
- 初学Delphi该看什么书???
- 请教高手关于如何把客户端一个目录下的所有文件上传到服务器上?
- 我是初学者,请教大家一个问题!
- 需要在Delphi程序中显示CAD图纸,寻找能CAD图纸的Delphi控件
- 40分一个NMSMTP发送邮件的问题
- 哪里有可打印的条形码控件下载?急
- 请教如何用delphi实现接收所有ping过来的icmp数据包并提取出来的啊?
- dbgrideh 一个单元格内怎么换行显示
- fastreport4.3的使用问题
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Excel2000, OleServer, OleCtnrs, DB, Grids, DBGrids,
ADODB;type
TForm1 = class(TForm)
ADOConnection1: TADOConnection;
ADOQuery1: TADOQuery;
DBGrid1: TDBGrid;
DataSource1: TDataSource;
OleContainer1: TOleContainer;
ExcelWorkbook1: TExcelWorkbook;
ExcelWorksheet1: TExcelWorksheet;
ExcelApplication1: TExcelApplication;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;var
Form1: TForm1;implementation{$R *.dfm}procedure TForm1.Button1Click(Sender: TObject);
var
i:integer;
begin
if fileexists('11.xls') then
deletefile('11.xls');try
excelapplication1.Connect ;
except
application.MessageBox('您的系统可能没有装EXCEL','提示',mb_okcancel);
exit;
end;//增加一个工作表
excelapplication1.Workbooks.Add(null,0);
excelworkbook1.ConnectTo(excelapplication1.Workbooks[1]);//增加一个工作页
try
excelworkbook1.Worksheets.Add(null,
excelworkbook1.Worksheets[excelworkbook1.Worksheets.count],null,null,0);
except
application.MessageBox('创建失败','提示',mb_okcancel);
exit;
end;excelworksheet1.ConnectTo(excelworkbook1.Worksheets[1]as _worksheet);//加上表头也就是字段名for i:=0 to adoquery1.FieldCount-1 do
begin
excelworksheet1.Cells.Item[1,i+1].value:=adoquery1.Fields[i].DisplayLabel ;
end;//开始导入数据adoquery1.First ;
while not adoquery1.Eof do
begin
for i:=0 to adoquery1.FieldCount-1 do
begin
excelworksheet1.Cells.Item[adoquery1.RecNo+1,i+1].value:=adoquery1.Fields[i].AsString ;
end;
adoquery1.Next ;
end;//保存记录try
excelworksheet1.SaveAs(extractfilepath(paramstr(0))+'11.xls');
except
application.MessageBox('保存失败','提示',mb_okcancel);
end;//所有都断开连接excelworksheet1.Disconnect ;
excelworkbook1.Disconnect ;
excelapplication1.Disconnect ;
excelapplication1.Quit ;//把EXCEL文件打开olecontainer1.CreateLinkToFile(extractfilepath(paramstr(0))+'11.xls',false);
olecontainer1.DoVerb(0);end;end.
晕死了。
有没有试过2000行以上的数据导出?
自己看看Excel文件的结构,自己写一个啦(我自己也写过,但只能导出到Excel 2.0格式的)
或者到2ccc上下载一个。
OLE模式系统必须安装Excel,而且版本很多时候都有限制,各个版本并非完全兼容,目前最好使用Office2003 OLE的缺点也相当明显,那就是慢,尤其是多余2000行的时候,基本是无法忍受的,曾经测试过,目前主流配置电脑写入速度大约是200单元格/秒,如果写一个2000行20列的Excel文件大约需要2000*20/200=200秒,大约3分钟,当然这是基本理论值,实际情况下一般超过5分钟
一个6000行80列的Excel文件在Core 2 2.0G/1G内存下30分钟后提示系统资源不足
至于5万行Excel想都别想 至于具体测试数据,等那天没事的时候在服务器(HP 至强4核,双CPU,8G)上测试看看,估计不容乐观。
但是如果读的话,目前基本只能用OLE模式,文件流模式或者ADOX模式(除非文件特别制作)基本不可行,MS把数据格式用一个HASH表存起来,格式搞的太复杂。
一个好消息,刚刚看到资料,几天前MS公开了Excel的文件格式,这样可以很轻松的以二进制方式进行写文件具体察看 http://www.microsoft.com/interop/docs/OfficeBinaryFormats.mspx就是不知道这份文档是否完整
{来源:该组件设计思想来自王寒松 CReport 中文报表组件,即直接用流写xls格式文件 }
{特点:该组件直接按照Excel各Cell格式用流的形式写Excel文件,所以无需安装Excel服务}{-------------- by 天行者 [email protected] @2005.12.27 ------------------------}
unit LynDataToXls;interfaceuses
SysUtils, Classes, DB;type
{表字段字典}
TLynField=record
id : integer; {序号}
name : string; {字段名称}
sName : string; {显示名称}
width : integer; {宽度}
end;
{字段列表--------------------------------------------------------------------}
TLynFieldList=record
nField: integer;
fields: array of TLynField;
end;type
TLynDataSetToExcel = Class(TComponent)
private
FMax: Word;
FCol: Word;
FRow: Word;
FFields: TLynFieldList;
FHeader: TStrings;
FFooter: TStrings;
FCaption: String;
FDataSet: TDataSet;
FStream: TStream;
FBookMark: TBook; procedure SetHeader(Value: TStrings);
procedure SetFooter(Value: TStrings); procedure IncColRow(NewRow: Boolean=FALSE);
procedure WriteBlankCell(NewRow: Boolean=FALSE);
procedure WriteFloatCell(const AValue: Double; NewRow: Boolean=FALSE);
procedure WriteIntegerCell(const AValue: Integer; NewRow: Boolean=FALSE);
procedure WriteStringCell(const AValue: String; NewRow: Boolean=FALSE);
procedure WritePrefix;
procedure WriteSuffix;
procedure WriteHeader;
procedure WriteColumnHead();
procedure WriteCaption;
procedure WriteFooter;
procedure WriteDataCell; procedure CalcMaxColumn();
procedure SaveExcelStream(Stream: TStream);
public
procedure SaveExcelFile(FileName: String);
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Fields : TLynFieldList read FFields write FFields;
property Header : TStrings read FHeader write SetHeader;
property Footer : TStrings read FFooter write SetFooter;
property Caption: String read FCaption write FCaption;
property DataSet: TDataSet read FDataSet write FDataSet;
end;procedure Register;implementationvar
XlsBof : array[0..5] of Word = ($809, 8, 0, $10, 0, 0);
XlsEof : array[0..1] of Word = ($0A, 00);
XlsLabel : array[0..5] of Word = ($204, 0, 0, 0, 0, 0);
XlsNumber: array[0..4] of Word = ($203, 14, 0, 0, 0);
XlsRk : array[0..4] Of Word = ($27E, 10, 0, 0, 0);
XlsBlank : array[0..4] of Word = ($201, 6, 0, 0, $17);procedure TLynDataSetToExcel.SetHeader(Value: TStrings);
begin
if Value=nil then FHeader.Clear
else FHeader.Assign(Value);
end;procedure TLynDataSetToExcel.SetFooter(Value: TStrings);
begin
if Value=nil then FFooter.Clear
else FFooter.Assign(Value);
end;constructor TLynDataSetToExcel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FDataSet := nil;
FHeader := TStringList.Create;
FFooter := TStringList.Create;
end;procedure TLynDataSetToExcel.IncColRow(NewRow: Boolean=FALSE);
begin
if (NewRow) or (FCol>=FMax-1) then
begin
FCol := 0;
Inc(FRow);
end
else Inc(FCol);
end;procedure TLynDataSetToExcel.WriteBlankCell(NewRow: Boolean=FALSE);
Begin
XlsBlank[2] := FRow;
XlsBlank[3] := FCol;
FStream.WriteBuffer(XlsBlank, sizeof(XlsBlank));
IncColRow(NewRow);
End;procedure TLynDataSetToExcel.WriteFloatCell(const AValue: Double; NewRow: Boolean=FALSE);
Begin
XlsNumber[2] := FRow;
XlsNumber[3] := FCol;
FStream.WriteBuffer(XlsNumber, sizeof(XlsNumber));
FStream.WriteBuffer(AValue, 8);
IncColRow(NewRow);
End;procedure TLynDataSetToExcel.WriteIntegerCell(Const AValue: Integer; NewRow: Boolean=FALSE);
var
V: Integer;
Begin
XlsRk[2] := FRow;
XlsRk[3] := FCol;
FStream.WriteBuffer(XlsRk, sizeof(XlsRk));
V := (AValue Shl 2) Or 2;
FStream.WriteBuffer(V, 4);
IncColRow(NewRow);
End;procedure TLynDataSetToExcel.WriteStringCell(Const AValue: String; NewRow: Boolean=FALSE);
Var
L: Word;
Begin
L := Length(AValue);
XlsLabel[1] := 8 + L;
XlsLabel[2] := FRow;
XlsLabel[3] := FCol;
XlsLabel[5] := L;
FStream.WriteBuffer(XlsLabel, sizeof(XlsLabel));
FStream.WriteBuffer(Pointer(AValue)^, L);
IncColRow(NewRow);
end;{写入前缀}
procedure TLynDataSetToExcel.WritePrefix;
Begin
FStream.WriteBuffer(XlsBof, sizeof(XlsBof));
End;{写入后缀}
procedure TLynDataSetToExcel.WriteSuffix;
begin
FStream.WriteBuffer(XlsEof, sizeof(XlsEof));
end;procedure TLynDataSetToExcel.WriteHeader;
var
i: Integer;
begin
for i:=0 to FHeader.Count-1 do WriteStringCell(FHeader[i],TRUE);
end;procedure TLynDataSetToExcel.WriteColumnHead();
var
n: Word;
begin
for n:=0 to FFields.nField-1 do
begin
WriteStringCell(FFields.Fields[n].sName);
end;
end;procedure TLynDataSetToExcel.WriteCaption;
begin
WriteStringCell(FCaption,TRUE);
end;procedure TLynDataSetToExcel.WriteFooter;
var
i: Integer;
begin
for i:=0 to FFooter.Count-1 do WriteStringCell(FFooter[i],TRUE);
end;procedure TLynDataSetToExcel.WriteDataCell;
var
n: Word;
Field: TField;
begin
WritePrefix(); {写入 Excel 文件头}
WriteHeader(); {写入题头}
WriteCaption; {写入标题}
WriteColumnHead(); {写入列标题} FDataSet.DisableControls;
FBookMark := FDataSet.GetBook;
FDataSet.First;
while not FDataSet.Eof do
begin
for n:=0 to FFields.nField-1 do
begin
Field :=FDataSet.FindField(FFields.Fields[n].name);
if Field<>nil then
begin
if Field.IsNull then WriteBlankCell
else begin
case Field.DataType of
ftSmallint,
ftInteger,
ftWord,
ftAutoInc,
ftBytes,
ftLargeint: WriteIntegerCell(Field.AsInteger);
ftFloat,
ftCurrency,
ftBCD: WriteFloatCell(Field.AsFloat);
ftString,
ftMemo,
ftFixedChar,
ftWideString,
ftTime,
ftDate: WriteStringCell(Field.AsString);
else WriteStringCell('');
end;
end;
end
else begin
WriteBlankCell();
end;
end;
FDataSet.Next;
end;
WriteSuffix;
WriteFooter;
FDataSet.GotoBook(FBookMark);
FDataSet.FreeBook(FBookMark);
FDataSet.EnableControls;
end;procedure TLynDataSetToExcel.CalcMaxColumn();
begin
FMax := FFields.nField;
end;procedure TLynDataSetToExcel.SaveExcelStream(Stream: TStream);
begin
if FDataSet=nil then Exception.Create('未指定导出数据集错误!');
FCol := 0;
FRow := 0;
CalcMaxColumn;
FStream := Stream;
WriteDataCell;
end;procedure TLynDataSetToExcel.SaveExcelFile(FileName: String);
var
FileStream: TFileStream;
begin
if FileExists(FileName) then DeleteFile(FileName);
FileStream := TFileStream.Create(FileName, fmCreate);
try
SaveExcelStream(FileStream);
finally
FileStream.Free;
end;
end;destructor TLynDataSetToExcel.Destroy;
begin
FHeader.Free;
FFooter.Free;
inherited Destroy;
end;procedure Register;
begin
RegisterComponents('LynLib', [TLynDataSetToExcel]);
end;end.