多表头的DBGridEH导出到Excel中

多表头的DBGridEH导出到Excel中
把自己的解决法子说一下,虽然解决的不是很完美,缺少单元格合并和字体设置。
我重写了单元DBGridEhImpExp中的函数TDBGridEhExportAsXLS.WriteTitle
希望有高手继续完善这个函数,让之最终导出的Excel格式和Elib一样。
//------------------------------------------------------------------
procedure TDBGridEhExportAsXLS.WriteTitle(ColumnsList: TColumnsEhList);
var
 i, k: Integer;
 FPTitleExpArr: TTitleExpArr;
 ListOfHeadTreeNodeList: TList;
 ColSpan, RowSpan: Integer;
 str1:String;
 L: Word; //writestringcell
begin
 if ColumnsList.Count = 0 then
  Exit;

 if DBGridEh.UseMultiTitle then
 begin
  try
   CreateMultiTitleMatrix(DBGridEh, ColumnsList, FPTitleExpArr, ListOfHeadTreeNodeList);
   //输出除最后一行表头的内容
   for k := ListOfHeadTreeNodeList.Count - 1 downto 1 do
   begin
    for i := 0 to ColumnsList.Count - 1 do
    begin
     if THeadTreeNode(TList(ListOfHeadTreeNodeList.Items[k]).Items[i]) <> nil then
     begin
      CalcSpan(ColumnsList, ListOfHeadTreeNodeList, k, i, ColSpan, RowSpan);
      str1:=THeadTreeNode(TList(ListOfHeadTreeNodeList.Items[k]).Items[i]).Text;
      //=====================================
      L := Length(str1);
      CXlsLabel[1] := 8 + L;
      CXlsLabel[2] := FRow;
      CXlsLabel[3] := FCol;
      CXlsLabel[5] := L;
      StreamWriteWordArray(Stream, CXlsLabel);
      StreamWriteAnsiString(Stream, str1);
      if FCol = ExpCols.Count - 1 then
      begin
       Inc(FRow);
       FCol := 0;
      end
      else
       FCol:=FCol+ColSpan;
      //=====================================
     end;
    end;
   end;
   FRow := ListOfHeadTreeNodeList.Count - 1;
   FCol :=0;
   //输出最后一行表头
   for i := 0 to ColumnsList.Count - 1 do
   begin
    if THeadTreeNode(TList(ListOfHeadTreeNodeList.Items[0]).Items[i]) <> nil then
    begin
     CalcSpan(ColumnsList, ListOfHeadTreeNodeList, 0, i, ColSpan, RowSpan);
     str1:=THeadTreeNode(TList(ListOfHeadTreeNodeList.Items[0]).Items[i]).Text;
     //WriteStringCell(str1);
     //==================================
     L := Length(str1);
     CXlsLabel[1] := 8 + L;
     CXlsLabel[2] := FRow;
     CXlsLabel[3] := FCol;
     CXlsLabel[5] := L*ColSpan;
     StreamWriteWordArray(Stream, CXlsLabel);
     StreamWriteAnsiString(Stream, str1);
     if FCol = ExpCols.Count - 1 then
     begin
      Inc(FRow);
      FCol := 0;
     end
     else
      FCol:=FCol+ColSpan;
     //==================================
    end
    else
    begin
     Inc(FCol);//单云格进一
    end;
   end;
   FRow:=ListOfHeadTreeNodeList.Count;
   FCol:=0;
  finally
   for i := 0 to ListOfHeadTreeNodeList.Count - 1 do
    TList(ListOfHeadTreeNodeList.Items[i]).Free;
   ListOfHeadTreeNodeList.Free;
  end;
 end
 else  //不使用多表头
 begin
  for i := 0 to ColumnsList.Count - 1 do
  begin
   WriteStringCell(ColumnsList[i].Title.Caption);
  end;
 end;
end;
//------------------------------------------------------------------

原文地址:https://www.cnblogs.com/beeone/p/1792342.html