delphi dbgrideh导出到Excel 多表头

找了好多资料，处理dbgrideh导出Excel多表头的情况。终于找到解决方法。有修改的话请联系我：QQ：826575071

引用单元

interface
  uses Vcl.ComCtrls,Winapi.CommCtrl,System.Win.ComObj,DBGridEh,Vcl.Forms;
implementation
  uses StrUtils,SysUtils,Vcl.Dialogs,Vcl.Controls,Data.DB,Variants;

正文如下：

procedure ExportToExcel(dbgrideh1:TDBGridEh;TitleName :String;autoFit:Boolean);

function isFloat(str :String):Boolean;
begin
  try
    StrToFloat(str);
  except
    Result := False;
  end;
  Result := True;
end;
function getSpecCount(substr, str: String): integer;
var i,count :integer;
begin
  i := 0;
  count := 1;
  while pos(substr,str)>0 do
  begin
    i := pos(substr,str);
    count := count + 1;
    str := RightStr(str,length(str)-i);
  end;
  result := count;
end;


function getSpaceI(sheet:Variant;row,col:integer):Integer;
var i:integer;
begin
  for I := row downto 2 do//首行为标题行
    if Sheet.cells[i, col].Value <> '' then
      break;
  result := i;
end;
var XLApp: Variant;
  Sheet: Variant; s1, s2: string;
  Caption: String; Row, Col: integer;
  iCount, jCount: Integer;
  FBookMark: TBookmark; FileName: String;
  SaveDialog1: TSaveDialog;
  i,ii,max :Integer; ti:TColumnTitleEh;
begin //如果数据集为空或没有打开则退出
  if not DBGridEh1.DataSource.DataSet.Active then Exit;
  SaveDialog1 := TSaveDialog.Create(Nil);
  SaveDialog1.FileName := TitleName + '_' + FormatDateTime('YYMMDDhhmmss', now);
  SaveDialog1.Filter := 'Excel文件|*.xls';
  if SaveDialog1.Execute then FileName := SaveDialog1.FileName;
  SaveDialog1.Free;
  if FileName = '' then Exit;
  Application.ProcessMessages;
  Screen.Cursor := crHourGlass; //鼠标指针为沙漏状
  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;
  //XLApp.Visible := True; //调试显示用
  XLApp.WorkBooks.Add;
  Sheet := XLApp.WorkSheets[1]; //写标题
  sheet.cells[1, 1] := TitleName;
  sheet.range[sheet.cells[1, 1], sheet.cells[1, DBGridEh1.Columns.Count]].Select; //选择该列
  XLApp.selection.HorizontalAlignment := 3; //居中
  XLApp.selection.MergeCells := True; //合并 //写表头
  Row := 1;
  for I := 0 to dbgrideh1.Columns.Count - 1 do
  begin
    ti := dbgrideh1.Columns[i].Title;
    ii := getSpecCount('|',ti.Caption) + 1;
    if Max < ii then
      Max := ii;
  end;
  jCount := max;
  for iCount := 0 to DBGridEh1.Columns.Count - 1 do
  begin
    Col := 2;
    Row := iCount+1;
    Caption := DBGridEh1.Columns[iCount].Title.Caption;
    while POS('|', Caption) > 0 do
    begin
      jCount := max+1;
      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 := 4;//$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 = max+1 then
    for iCount := 1 to DBGridEh1.Columns.Count do
      if Sheet.cells[max, iCount].Value = '' then
      begin
        i := getSpaceI(Sheet,max,iCount);
        sheet.range[sheet.cells[i{max-1}, iCount],sheet.cells[max, iCount]].Select;
        XLApp.selection.HorizontalAlignment := 4;//$FFFFEFF4;
        XLApp.selection.MergeCells := True;
      end
      else
      begin
        sheet.cells[max, iCount].Select;
        XLApp.selection.HorizontalAlignment := 3;//$FFFFEFF4;
      end; //读取数据
  DBGridEh1.DataSource.DataSet.DisableControls;
  FBookMark := DBGridEh1.DataSource.DataSet.GetBookmark;
  DBGridEh1.DataSource.DataSet.First;
  while not DBGridEh1.DataSource.DataSet.Eof do
  begin
    for iCount := 1 to DBGridEh1.Columns.Count do
    begin
      Sheet.cells[jCount, iCount] := DBGridEh1.Columns.Items[iCount-1].Field.AsString;
      if (Pos('.',DBGridEh1.Columns.Items[iCount-1].Field.AsString)>0)
        and isFloat(DBGridEh1.Columns.Items[iCount-1].Field.AsString) then
          Sheet.cells[jCount, iCount].numberformatlocal:=OleVariant('0.00');
    end;
    Inc(jCount);
    DBGridEh1.DataSource.DataSet.Next;
  end;
  if DBGridEh1.DataSource.DataSet.BookmarkValid(FBookMark) then
  DBGridEh1.DataSource.DataSet.GotoBookmark(FBookMark);
  DBGridEh1.DataSource.DataSet.EnableControls; //读取表脚
  if DBGridEh1.FooterRowCount > 0 then
  begin
    for Row := 0 to DBGridEh1.FooterRowCount-1 do
    begin
      for Col := 0 to DBGridEh1.Columns.Count-1 do
        Sheet.cells[jCount, Col+1] := DBGridEh1.GetFooterValue(Row,DBGridEh1.Columns[Col]);
      Inc(jCount);
    end;
  end; //调整列宽
  if autoFit then
    for iCount := 1 to DBGridEh1.Columns.Count do
      Sheet.Columns[iCount].EntireColumn.AutoFit;
  sheet.cells[1, 1].Select;
  XlApp.Visible := True;
  XlApp.Workbooks[1].SaveAs(FileName);
  XlApp := Unassigned;
  Screen.Cursor := crDefault;
end;