两个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;  

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