今天要把DataSet导入Excel，查询以前的贴子，一部分用Ole，速度太慢，一部分用ADO连接到Excel文件，也很慢，一气之下把DBGrigEh的导出部分

今天要把DataSet导入Excel，查询以前的贴子，一部分用Ole，速度太慢，一部分用ADO连接到Excel文件，也很慢，一气之下把DBGrigEh的导出部分改了出来，欢迎大家指教、改进。(50分)<br />{ 背景：今天要把DataSet导入Excel，查询以前的贴子，一部分用Ole，速度太慢，
一部分用ADO连接到Excel文件，也很慢，一气之下把DBGrigEh的导出部分改了出来，
欢迎大家指教、改进。
功能：将数据集的数据导入Excel;
用法：With TDS2Excel.Create(TDataSet(ADOQuery1)) do
Try
Save2File(SaveDialog1.FileName, True);
finally
Free;
end;
作者：Caidao (核心代码来自Ehlib)
时间：2003-04-09
地点：汕头
}


unit UntObject;

interface

Uses
DB, Classes;

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);



Type
TDS2Excel = Class(TObject)
Private
FCol: word;
FRow: word;
FDataSet: TDataSet;
Stream: TStream;
FWillWriteHead: boolean;
FBookMark: TBookmark;
procedure IncColRow;
procedure WriteBlankCell;
procedure WriteFloatCell(const AValue: Double);
procedure WriteIntegerCell(const AValue: Integer);
procedure WriteStringCell(const AValue: string);
procedure WritePrefix;
procedure WriteSuffix;
procedure WriteTitle;
procedure WriteDataCell;

procedure Save2Stream(aStream: TStream);
Public
procedure Save2File(FileName: string; WillWriteHead: Boolean);
Constructor Create(aDataSet: TDataSet);
end;

implementation

uses SysUtils;

Constructor TDS2Excel.Create(aDataSet: TDataSet);
begin
inherited Create;
FDataSet := aDataSet;
end;

procedure TDS2Excel.IncColRow;
begin
if FCol = FDataSet.FieldCount - 1 then
begin
Inc(FRow);
FCol :=0;
end
else
Inc(FCol);
end;

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

procedure TDS2Excel.WriteFloatCell(const AValue: Double);
begin
CXlsNumber[2] := FRow;
CXlsNumber[3] := FCol;
Stream.WriteBuffer(CXlsNumber, SizeOf(CXlsNumber));
Stream.WriteBuffer(AValue, 8);
IncColRow;
end;

procedure TDS2Excel.WriteIntegerCell(const AValue: Integer);
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);
IncColRow;
end;

procedure TDS2Excel.WriteStringCell(const AValue: string);
var
L: Word;
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);
IncColRow;
end;

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

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

procedure TDS2Excel.WriteTitle;
var
n: word;
begin
for n := 0 to FDataSet.FieldCount - 1 do
WriteStringCell(FDataSet.Fields[n].FieldName);
end;

procedure TDS2Excel.WriteDataCell;
var
n: word;
begin
WritePrefix;
if FWillWriteHead then WriteTitle;
FDataSet.DisableControls;
FBookMark := FDataSet.GetBookmark;
FDataSet.First;
while not FDataSet.Eof do
begin
for n := 0 to FDataSet.FieldCount - 1 do
begin
if FDataSet.Fields[n].IsNull then
WriteBlankCell
else begin
case FDataSet.Fields[n].DataType of
ftSmallint, ftInteger, ftWord, ftAutoInc, ftBytes:
WriteIntegerCell(FDataSet.Fields[n].AsInteger);
ftFloat, ftCurrency, ftBCD:
WriteFloatCell(FDataSet.Fields[n].AsFloat);
else
WriteStringCell(FDataSet.Fields[n].AsString);
end;
end;
end;
FDataSet.Next;
end;
WriteSuffix;
if FDataSet.BookmarkValid(FBookMark) then FDataSet.GotoBookmark(FBookMark);
FDataSet.EnableControls;
end;

procedure TDS2Excel.Save2Stream(aStream: TStream);
begin
FCol := 0;
FRow := 0;
Stream := aStream;
WriteDataCell;
end;

procedure TDS2Excel.Save2File(FileName: string; WillWriteHead: Boolean);
var
aFileStream: TFileStream;
begin
FWillWriteHead := WillWriteHead;
if FileExists(FileName) then DeleteFile(FileName);
aFileStream := TFileStream.Create(FileName, fmCreate);
Try
Save2Stream(aFileStream);
Finally
aFileStream.Free;
end;
end;

end.

我来试试。
经测试通过，速度的确挺快，对简单数据类型的导出为Excel表很方便。

不错不错，支持支持！

确实很好，但是否可以生成固定版式的excel表呢？

学习。

很好.
要是有转成Word文件的代码就更好了.

确实不错，如果再完善一下就更好了，
比如：
判断字段的Tag属性大于某个值不导出、
设置单元格的宽度（根据DisplayWidth属性）、
单元格画边框之类的功能

好像挺简单的

uses ComObj;

procedure DataSetToExcel(ADataSet: TCustomADODataSet; const AFileName: string);
var
Table, ExcelApp, ExcelBook, ExcelSheet: Variant;
begin
if not ADataSet.Active then Exit;
ExcelApp := CreateOleObject('Excel.Application');
ExcelBook := ExcelApp.WorkBooks.Add;
ExcelSheet := ExcelBook.Sheets.Item[1];
Table := ExcelSheet.QueryTables.Add(ADataSet.Recordset, ExcelSheet.Range['A1']);
Table.Refresh(True);
ExcelBook.Close(True, AFileName);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
ADOTable1.Open;
DataSetToExcel(ADOTable1, 'c:/aa.xls');
end;

呵呵,这个好像是直接写成xls文件格式的.
不知道导出的xls文件的版本是多少?

copy_paste的方法好像需要装有Excel才行，而且比较慢。
导出的xls文件好像不是任何版本的，但可以用Excel打开。

收藏

就是，我也不知道是什么版本，关键代码来自EhLib

to copy_paste
你的代码不好，需要安装Execl。而且楼主的是直接写文件的方式速度很快。

to caidao: 看不懂你给出的程序和‘用法’，能指点一下我这个菜鸟吗？

to Caidao
能不能问一下，这解释一下这几句吗？
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);

谢谢！

直接用XLreport控件一切都搞定。

老大,多行表头如何导出到EXCEL？？？

up

多人接受答案了。

在处理整型时出错，试试 90000000