两个DataGridEHToExcel

procedure TForm1.N1Click(Sender: TObject);
var
GridtoExcel: TDBGridEhToExcel;
begin
try
GridtoExcel := TDBGridEhToExcel.Create(nil);
GridtoExcel.DBGridEh := DBGridEh1;         //需要导出数据的DBGridEh文件名
GridtoExcel.TitleName := 'EXCEL的标题';   //根据需要自行修改
GridtoExcel.ShowProgress := true;
GridtoExcel.ShowOpenExcel := true;
GridtoExcel.ExportToExcel;
finally
GridtoExcel.Free;
end;
end;

　　

1、以上代码是再窗体中使用的；

2、将下列代码保存为：ToExcel.pas 并且引用即可。

unit ToExcel;

interface
uses
SysUtils, Variants, Classes, Graphics, Controls, Forms, Excel2000, ComObj,
Dialogs, DB, DBGridEh, windows,ComCtrls,ExtCtrls;

type

TDBGridEhToExcel = class(TComponent)
private
FProgressForm: TForm;                                  {进度窗体}
FtempGauge: TProgressBar;                           {进度条}
FShowProgress: Boolean;                                {是否显示进度窗体}
FShowOpenExcel:Boolean;                                {是否导出后打开Excel文件}
FDBGridEh: TDBGridEh;
FTitleName: TCaption;                                  {Excel文件标题}
FUserName: TCaption;                                   {制表人}
procedure SetShowProgress(const Value: Boolean);       {是否显示进度条}
procedure SetShowOpenExcel(const Value: Boolean);      {是否打开生成的Excel文件}
procedure SetDBGridEh(const Value: TDBGridEh);
procedure SetTitleName(const Value: TCaption);         {标题名称}
procedure SetUserName(const Value: TCaption);          {使用人名称}
procedure CreateProcessForm(AOwner: TComponent);       {生成进度窗体}
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 ShowOpenExcel: Boolean read FShowOpenExcel write SetShowOpenExcel; //是否打开Excel
property TitleName: TCaption read FTitleName write SetTitleName;
property UserName: TCaption read FUserName write SetUserName;
end;

implementation

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

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

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

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

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

function IsFileInUse(fName: string ): boolean;
var
HFileRes: HFILE;
begin
Result :=false;
if not FileExists(fName) then exit;
HFileRes :=CreateFile(pchar(fName), GENERIC_READ
or GENERIC_WRITE,0, nil,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL, 0);
Result :=(HFileRes=INVALID_HANDLE_VALUE);
if not Result then
CloseHandle(HFileRes);
end;

procedure TDBGridEhToExcel.ExportToExcel;
var
XLApp: Variant;
Sheet: Variant;
s1, s2: string;
Caption,Msg: String;
Row, Col: integer;
iCount, jCount: Integer;
FBookMark: TBookmark;
FileName: String;
SaveDialog1: TSaveDialog;
begin
//如果数据集为空或没有打开则退出
if not DBGridEh.DataSource.DataSet.Active then Exit;

SaveDialog1 := TSaveDialog.Create(Nil);
SaveDialog1.FileName :=TitleName + '_' + FormatDateTime('YYYY-MM-DD[HHMMSS]', now);
SaveDialog1.Filter := 'Excel文件|*.xls';
if SaveDialog1.Execute then
FileName := SaveDialog1.FileName;
SaveDialog1.Free;
if FileName = '' then Exit;

while IsFileInUse(FileName) do
begin
if Application.MessageBox('目标文件使用中，请退出目标文件后点击确定继续！',
'注意', MB_OKCANCEL + MB_ICONWARNING) = IDOK then
begin

end
else
begin
Exit;
end;
end;

if FileExists(FileName) then
begin
Msg := '已存在文件（' + FileName + '），是否覆盖？';
if Application.MessageBox(PChar(Msg), '提示', MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2) = IDYES then
begin
//删除文件
DeleteFile(PChar(FileName))
end
else
exit;
end;
Application.ProcessMessages;

Screen.Cursor := crHourGlass;
//显示进度窗体
if ShowProgress then
CreateProcessForm(nil);

if not VarIsEmpty(XLApp) then
begin
XLApp.DisplayAlerts := False;
XLApp.Quit;
VarClear(XLApp);
end;

//通过ole创建Excel对象
try
XLApp := CreateOleObject('Excel.Application');
except
MessageDlg('创建Excel对象失败，请检查你的系统是否正确安装了Excel软件！', mtError, [mbOk], 0);
Screen.Cursor := crDefault;
Exit;
end;

//生成工作页
XLApp.WorkBooks.Add[XLWBatWorksheet];
XLApp.WorkBooks[1].WorkSheets[1].Name := TitleName;
Sheet := XLApp.Workbooks[1].WorkSheets[TitleName];

//写标题
sheet.cells[1, 1] := TitleName;
sheet.range[sheet.cells[1, 1], sheet.cells[1, DBGridEh.Columns.Count]].Select; //选择该列
XLApp.selection.HorizontalAlignment := $FFFFEFF4;                               //居中
XLApp.selection.MergeCells := True;                                             //合并

//写表头
Row := 1;
jCount := 3;
for iCount := 0 to DBGridEh.Columns.Count - 1 do
begin
Col := 2;
Row := iCount+1;
Caption := DBGridEh.Columns[iCount].Title.Caption;
while POS('|', Caption) > 0 do
begin
jCount := 4;
s1 := Copy(Caption, 1, Pos('|',Caption)-1);
if s2 = s1 then
begin
sheet.range[sheet.cells[Col, Row-1],sheet.cells[Col, Row]].Select;
XLApp.selection.HorizontalAlignment := $FFFFEFF4;
XLApp.selection.MergeCells := True;
end
else
Sheet.cells[Col,Row] := Copy(Caption, 1, Pos('|',Caption)-1);
Caption := Copy(Caption,Pos('|', Caption)+1, Length(Caption));
Inc(Col);
s2 := s1;
end;
Sheet.cells[Col, Row] := Caption;
Inc(Row);
end;

//合并表头并居中
if jCount = 4 then
for iCount := 1 to DBGridEh.Columns.Count do
if Sheet.cells[3, iCount].Value = '' then
begin
sheet.range[sheet.cells[2, iCount],sheet.cells[3, iCount]].Select;
XLApp.selection.HorizontalAlignment := $FFFFEFF4;
XLApp.selection.MergeCells := True;
end
else begin
sheet.cells[3, iCount].Select;
XLApp.selection.HorizontalAlignment := $FFFFEFF4;
end;

//读取数据
DBGridEh.DataSource.DataSet.DisableControls;
FBookMark := DBGridEh.DataSource.DataSet.GetBookmark;
DBGridEh.DataSource.DataSet.First;
while not DBGridEh.DataSource.DataSet.Eof do
begin

for iCount := 1 to DBGridEh.Columns.Count do
begin
//Sheet.cells[jCount, iCount] :=DBGridEh.Columns.Items[iCount-1].Field.AsString;

case DBGridEh.DataSource.DataSet.FieldByName(DBGridEh.Columns.Items[iCount-1].FieldName).DataType of
ftSmallint, ftInteger, ftWord, ftAutoInc, ftBytes:
Sheet.cells[jCount, iCount] :=DBGridEh.Columns.Items[iCount-1].Field.asinteger;
ftFloat, ftCurrency, ftBCD:
Sheet.cells[jCount, iCount] :=DBGridEh.Columns.Items[iCount-1].Field.AsFloat;
else
if DBGridEh.DataSource.DataSet.FieldByName(DBGridEh.Columns.Items[iCount-1].FieldName) is TBlobfield then // 此类型的字段(图像等)暂无法读取显示
Sheet.cells[jCount, iCount] :=DBGridEh.Columns.Items[iCount-1].Field.AsString
else
Sheet.cells[jCount, iCount] :=''''+DBGridEh.Columns.Items[iCount-1].Field.AsString;
end;

end;
Inc(jCount);

//显示进度条进度过程
if ShowProgress then
begin
FtempGauge.Position := DBGridEh.DataSource.DataSet.RecNo;
FtempGauge.Refresh;
end;

DBGridEh.DataSource.DataSet.Next;
end;
if DBGridEh.DataSource.DataSet.BookmarkValid(FBookMark) then
DBGridEh.DataSource.DataSet.GotoBookmark(FBookMark);
DBGridEh.DataSource.DataSet.EnableControls;

//读取表脚
if DBGridEh.FooterRowCount > 0 then
begin
for Row := 0 to DBGridEh.FooterRowCount-1 do
begin
for Col := 0 to DBGridEh.Columns.Count-1 do
Sheet.cells[jCount, Col+1] := DBGridEh.GetFooterValue(Row,DBGridEh.Columns[Col]);
Inc(jCount);
end;
end;

//调整列宽
//    for iCount := 1 to DBGridEh.Columns.Count do
//        Sheet.Columns[iCount].EntireColumn.AutoFit;

sheet.cells[1, 1].Select;
XlApp.Workbooks[1].SaveAs(FileName);

XlApp.Visible := True;
XlApp := Unassigned;

if ShowProgress then
FreeAndNil(FProgressForm);
Screen.Cursor := crDefault;

end;

destructor TDBGridEhToExcel.Destroy;
begin
inherited Destroy;
end;

procedure TDBGridEhToExcel.CreateProcessForm(AOwner: TComponent);
var
Panel: TPanel;
begin
if Assigned(FProgressForm) then
exit;

FProgressForm := TForm.Create(AOwner);
with FProgressForm do
begin
try
Font.Name := '宋体';                                  {设置字体}
Font.Size := 10;
BorderStyle := bsNone;
Width := 300;
Height := 30;
BorderWidth := 1;
Color := clBlack;
Position := poScreenCenter;
Panel := TPanel.Create(FProgressForm);
with Panel do
begin
Parent := FProgressForm;
Align := alClient;
Caption := '正在导出Excel，请稍候......';
Color:=$00E9E5E0;
end;
FtempGauge:=TProgressBar.Create(Panel);
with FtempGauge do
begin
Parent := Panel;
Align:=alClient;
Min := 0;
Max:= DBGridEh.DataSource.DataSet.RecordCount;
Position := 0;
end;
except

end;
end;
FProgressForm.Show;
FProgressForm.Update;
end;

procedure TDBGridEhToExcel.SetShowOpenExcel(const Value: Boolean);
begin
FShowOpenExcel:=Value;
end;

end.

·····················································································第一种················································································

unit 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[i].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[i].Visible then
begin
Col := 0;
Caption := DBGridEh.Columns[i].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[i].Title.Caption) do
begin
if DBGridEh.Columns[i].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[i].IsNull or (not DBGridEh.DataSource.DataSet.Fields[i].Visible) then
WriteBlankCell
else
begin
case DBGridEh.DataSource.DataSet.Fields[i].DataType of
ftSmallint, ftInteger, ftWord, ftAutoInc, ftBytes:
WriteIntegerCell(DBGridEh.DataSource.DataSet.Fields[i].AsInteger);
ftFloat, ftCurrency, ftBCD:
WriteFloatCell(DBGridEh.DataSource.DataSet.Fields[i].AsFloat);
else
if DBGridEh.DataSource.DataSet.Fields[i] Is TBlobfield then  // 此类型的字段(图像等)暂无法读取显示
WriteStringCell('')
else
WriteStringCell(DBGridEh.DataSource.DataSet.Fields[i].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[i].Visible then
begin
WriteStringCell(DBGridEh.Columns[i].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[i].Visible then
begin
for j := 0 to DBGridEh.Columns[i].Footers.Count - 1 do
begin
WriteStringCell(DBGridEh.Columns[i].Footers[j].Value ,False);
Inc(FRow);
end;
Inc(FCol);
FRow := FRow - DBGridEh.Columns[i].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[i].FieldName).Index := i;
DBGridEh.DataSource.DataSet.FieldByName(DBGridEh.Columns.Items[i].FieldName).DisplayLabel
:= DBGridEh.Columns.Items[i].Title.Caption;
DBGridEh.DataSource.DataSet.FieldByName(DBGridEh.Columns.Items[i].FieldName).Visible :=
DBGridEh.Columns.Items[i].Visible;
end;

for i := 0 to DBGridEh.DataSource.DataSet.FieldCount - 1 do
begin
if POS('*****',DBGridEh.DataSource.DataSet.Fields[i].DisplayLabel) > 0 then
DBGridEh.DataSource.DataSet.Fields[i].Visible := False;
end;
end;

end.

/*****************************************************************/

调用的例子

var
DBGridEhToExcel: TDBGridEhToExcel;
begin
DBGridEhToExcel := TDBGridEhToExcel.Create(nil);
try
DBGridEhToExcel.TitleName := '测试测试测试测试测试测试测试';
DBGridEhToExcel.BeginDate := '开始日期：2005-07-01';
DBGridEhToExcel.EndDate := '结束日期：2005-07-18';
DBGridEhToExcel.UserName := '系统管理员';
DBGridEhToExcel.DBGridEh := DBGridEh1;
DBGridEhToExcel.ShowProgress := True;
DBGridEhToExcel.FileName := 'c:\123.xls';
DBGridEhToExcel.ExportToExcel;
finally
DBGridEhToExcel.Free;
end;

··········································································第二种····································································