【搞定】带分组的表格文档 导出为 excel？？**

alang

unit SHEETDOCLIB;

interface

uses
  Business.System, Business.Model, Business.Forms, Business.Data;

type
  TSHEETDOCLIB = class(TBizLibrary)
  private
    static procedure InitExpr(ASheet: TSheet; AArea: TSheetArea; AStatistician: TDBSheetStatistician);
  public
    {public declarations}
    static procedure CopySheet(ASrcDoc: TSheetDoc; ADstSheet: TSheet); overload;
    static procedure CopySheet(ASrcDoc, ADstDoc: TSheetDoc); overload;
    static procedure CopySheet(ASrcDocView, ADstDocView: TDocView); overload;

    static procedure CopySheetToExcel(ASrcDoc: TSheetDoc; AFileName: string); overload;
    static procedure CopySheetToExcel(ASrcDocView: TDocView; AFileName: string); overload;

    static procedure CopySheetToExcel(ASrcDoc: TSheetDoc; AFileName: string; const AOutDisplayText: Boolean); overload;
    static procedure CopySheetToExcel(ASrcDocView: TDocView; AFileName: string; const AOutDisplayText: Boolean); overload;

    static procedure CopyArea(ASrcSheet, ADstSheet: TSheet; AArea: TSheetArea; const ALeft, ARight: Integer; var ARowOffset: Integer);
    static procedure CopyAreaSection(ASrcSheet, ADstSheet: TSheet; ARect: TRect; const ALeft, ATop, ARowOffset: Integer);
  end;

  TGroupValue = class(TObject)
  public
    FieldName: string;
    OldValue: string;
    NewValue: string;
    Left, Right, Top, Bottom: integer;
    Offset: integer;
    Statistician: TDBSheetStatistician;
  end;


implementation


static procedure TSHEETDOCLIB.InitExpr(ASheet: TSheet; AArea: TSheetArea; AStatistician: TDBSheetStatistician);
var
  I, J: integer;
begin
  AStatistician.InitAreaCells(AArea);
  for I := AArea.Left to AArea.Right - 1 do
    for J := AArea.Top to AArea.Bottom - 1 do
      if ASheet.PeekCells[I, J] is TExprCell then
        TExprCell(ASheet.PeekCells[I, J]).Statistician := AStatistician;
end;

static procedure TSHEETDOCLIB.CopySheet(ASrcDoc: TSheetDoc; ADstSheet: TSheet);
var
  I: Integer;
  lDstSheet, lSrcSheet: TSheet;
  lArea: TSheetArea;
  lRowOffset: Integer;
  lMiddleTop, lMiddleBottom, lLeft, lRight: Integer;
begin
    lSrcSheet := ASrcDoc.Sheet;
    lDstSheet := ADstSheet;

    lDstSheet.RowCount := lSrcSheet.RowCount;
    lDstSheet.ColCount := lSrcSheet.ColCount;
    for I := 0 to lSrcSheet.ColCount - 1 do
      lDstSheet.ColWidths[I] := lSrcSheet.ColWidths[I];

    lRowOffset := 0;
    lMiddleTop := 0;
    lLeft := 0;
    lRight := lSrcSheet.ColCount - 1;
    for I := 0 to lSrcSheet.Areas.Count - 1 do
    begin
      lArea := lSrcSheet.Areas.Items[I];
      lMiddleBottom := lArea.Top - 1;
      CopyAreaSection(lSrcSheet, lDstSheet, Types.Rect(lLeft, lMiddleTop, lRight + 1, lMiddleBottom + 1),
        lLeft, lMiddleTop, lRowOffset);
      CopyArea(lSrcSheet, lDstSheet, lArea, 0, lSrcSheet.ColCount - 1, lRowOffset);
      lMiddleTop := lArea.Bottom;
    end;
    lMiddleBottom := lSrcSheet.RowCount - 1;
    CopyAreaSection(lSrcSheet, lDstSheet, Types.Rect(lLeft, lMiddleTop, lRight + 1, lMiddleBottom + 1),
      lLeft, lMiddleTop, lRowOffset);
end;

static procedure TSHEETDOCLIB.CopySheet(ASrcDoc, ADstDoc: TSheetDoc);
var
  I: Integer;
  lDstSheet, lSrcSheet: TSheet;
  lArea: TSheetArea;
  lRowOffset: Integer;
  lMiddleTop, lMiddleBottom, lLeft, lRight: Integer;
begin
    lSrcSheet := ASrcDoc.Sheet;
    lDstSheet := ADstDoc.Sheet;

    lDstSheet.RowCount := lSrcSheet.RowCount;
    lDstSheet.ColCount := lSrcSheet.ColCount;
    for I := 0 to lSrcSheet.ColCount - 1 do
      lDstSheet.ColWidths[I] := lSrcSheet.ColWidths[I];

    lRowOffset := 0;
    lMiddleTop := 0;
    lLeft := 0;
    lRight := lSrcSheet.ColCount - 1;
    for I := 0 to lSrcSheet.Areas.Count - 1 do
    begin
      lArea := lSrcSheet.Areas.Items[I];
      lMiddleBottom := lArea.Top - 1;
      CopyAreaSection(lSrcSheet, lDstSheet, Types.Rect(lLeft, lMiddleTop, lRight + 1, lMiddleBottom + 1),
        lLeft, lMiddleTop, lRowOffset);
      CopyArea(lSrcSheet, lDstSheet, lArea, 0, lSrcSheet.ColCount - 1, lRowOffset);
      lMiddleTop := lArea.Bottom;
    end;
    lMiddleBottom := lSrcSheet.RowCount - 1;
    CopyAreaSection(lSrcSheet, lDstSheet,Types.Rect(lLeft, lMiddleTop, lRight + 1, lMiddleBottom + 1),
      lLeft, lMiddleTop, lRowOffset);
end;
static procedure TSHEETDOCLIB.CopySheet(ASrcDocView, ADstDocView: TDocView);
var
  I: Integer;
  lDstSheet, lSrcSheet: TSheet;
  lArea: TSheetArea;
  lRowOffset: Integer;
  lMiddleTop, lMiddleBottom, lLeft, lRight: Integer;
begin
    lSrcSheet := TSheetDoc(ASrcDocView.Doc).Sheet;
    lDstSheet := TSheetDoc(ADstDocView.Doc).Sheet;

    lDstSheet.RowCount := lSrcSheet.RowCount;
    lDstSheet.ColCount := lSrcSheet.ColCount;
    for I := 0 to lSrcSheet.ColCount - 1 do
      lDstSheet.ColWidths[I] := lSrcSheet.ColWidths[I];

    lRowOffset := 0;
    lMiddleTop := 0;
    lLeft := 0;
    lRight := lSrcSheet.ColCount - 1;
    for I := 0 to lSrcSheet.Areas.Count - 1 do
    begin
      lArea := lSrcSheet.Areas.Items[I];
      lMiddleBottom := lArea.Top - 1;
      CopyAreaSection(lSrcSheet, lDstSheet, Types.Rect(lLeft, lMiddleTop, lRight + 1,lMiddleBottom + 1),
        lLeft, lMiddleTop, lRowOffset);
      CopyArea(lSrcSheet, lDstSheet, lArea, 0, lSrcSheet.ColCount - 1, lRowOffset);
      lMiddleTop := lArea.Bottom;
    end;
    lMiddleBottom := lSrcSheet.RowCount - 1;
    CopyAreaSection(lSrcSheet, lDstSheet, Types.Rect(lLeft, lMiddleTop, lRight + 1,lMiddleBottom + 1),
      lLeft, lMiddleTop, lRowOffset);
end;

static procedure TSHEETDOCLIB.CopySheetToExcel(ASrcDoc: TSheetDoc; AFileName: string);
var
  lDstSheet: TSheet;
  lExcelExp: TExcelExporter;
begin
  lDstSheet := TSheet.Create(nil);
  lExcelExp := TExcelExporter.Create(lDstSheet);
  try
    CopySheet(ASrcDoc, lDstSheet);
    lExcelExp.ExportToFile(AFileName);
  finally
    lExcelExp.Free;
    lDstSheet.Free;
  end;
end;

static procedure TSHEETDOCLIB.CopySheetToExcel(ASrcDocView: TDocView; AFileName: string);
var
  lDstSheet: TSheet;
  lExcelExp : TExcelExporter;
begin
  lDstSheet := TSheet.Create(nil);
  lExcelExp := TExcelExporter.Create(lDstSheet);
  try
    CopySheet(TSheetDoc(ASrcDocView.Doc), lDstSheet);
    lExcelExp.ExportToFile(AFileName);
  finally
    lExcelExp.Free;
    lDstSheet.Free;
  end;
end;

static procedure TSHEETDOCLIB.CopySheetToExcel(ASrcDoc: TSheetDoc; AFileName: string; const AOutDisplayText: Boolean);
var
  lDstSheet: TSheet;
  lExcelExp: TExcelExporter;
begin
  lDstSheet := TSheet.Create(nil);
  lExcelExp := TExcelExporter.Create(lDstSheet);
  try
    CopySheet(ASrcDoc, lDstSheet);
    {老版本如果编译不过下面此语句，先注释掉
    但会有：Sheet导出到Excel表现和Sheet表现不一致。（200610032001）。}
    lExcelExp.OutDisplayText := AOutDisplayText;
    lExcelExp.ExportToFile(AFileName);
  finally
    lExcelExp.Free;
    lDstSheet.Free;
  end;
end;

static procedure TSHEETDOCLIB.CopySheetToExcel(ASrcDocView: TDocView; AFileName: string; const AOutDisplayText: Boolean);
var
  lDstSheet: TSheet;
  lExcelExp : TExcelExporter;
begin
  lDstSheet := TSheet.Create(nil);
  lExcelExp := TExcelExporter.Create(lDstSheet);
  try
    CopySheet(TSheetDoc(ASrcDocView.Doc), lDstSheet);
    {老版本如果编译不过下面此语句，先注释掉
    但会有：Sheet导出到Excel表现和Sheet表现不一致。（200610032001）。}
    lExcelExp.OutDisplayText := AOutDisplayText;
    lExcelExp.ExportToFile(AFileName);
  finally
    lExcelExp.Free;
    lDstSheet.Free;
  end;
end;

(*******************************原函数**********************************************
static procedure TSHEETDOCLIB.CopyArea(ASrcSheet, ADstSheet: TSheet; AArea:TSheetArea;
  const ALeft, ARight: Integer; var ARowOffset: Integer);
var
  I: Integer;
  lUpsBottom, lDownsTop: Integer;
  lDataAreaHeight: Integer;
  lDataSet: TDataSet;
  lOutRecCount: Integer;
  lMiddleTop, lMiddleBottom: Integer;
  lArea: TSheetArea;
begin
  {数据集区域输出}
  if Business.Forms.jsGrids.AreaClass2Type(AArea) = TAreaType.atDBArea then
  begin
    lDataset := TDataSheet(ASrcSheet).FindDataSet(TDataSheetArea(AArea).DataSetDefID);
    lUpsBottom := AArea.Top + AArea.HeaderRows + AArea.PageHeaderRows + AArea.GroupHeaderRows + 1;
    CopyAreaSection(ASrcSheet, ADstSheet, Types.Rect(ALeft, AArea.Top, ARight,lUpsBottom),
      ALeft, AArea.Top, ARowOffset);
    if TDataSheetArea(AArea).PrintRange = TAreaPrintRange.aprAll then
    begin
      lOutRecCount := lDataSet.RecordCount;
      lDataSet.First;
    end
    else if TDataSheetArea(AArea).PrintRange = TAreaPrintRange.aprTopN then
    begin
      lOutRecCount := TDataSheetArea(AArea).TopNRecords;
      lDataSet.First;
    end
    else if TDataSheetArea(AArea).PrintRange = TAreaPrintRange.aprCurrent then
      lOutRecCount := 1
    else
      lOutRecCount := 0;
    lDataAreaHeight := TDataSheetArea(AArea).ClientHeight;
    repeat
      lMiddleTop := AArea.Top + AArea.HeaderRows + AArea.PageHeaderRows + AArea.GroupHeaderRows;
      for I := 0 to AArea.SubAreas.Count - 1 do
      begin
        lArea := AArea.SubAreas.Items[I];
        lMiddleBottom := lArea.Top ;
        CopyAreaSection(ASrcSheet, ADstSheet, Types.Rect(ALeft, lMiddleTop, ARight, lMiddleBottom),
          ALeft, lMiddleTop, ARowOffset);
        CopyArea(ASrcSheet, ADstSheet, lArea, ALeft, ARight, ARowOffset);
        lMiddleTop := lArea.Bottom;
      end;
      lMiddleBottom := AArea.Bottom;
      CopyAreaSection(ASrcSheet, ADstSheet, Types.Rect(ALeft, lMiddleTop, ARight, lMiddleBottom),
        ALeft, lMiddleTop, ARowOffset);

      lDataSet.Next;
      ARowOffset := ARowOffset + lDataAreaHeight;
      ADstSheet.RowCount := ASrcSheet.RowCount + ARowOffset;
      Dec(lOutRecCount);
      {测试用}
      if lDataSet.RecNo > 50 then
        break;
    until lDataSet.Eof or (lOutRecCount < 1);
    ARowOffset := ARowOffset - lDataAreaHeight;
    ADstSheet.RowCount := ASrcSheet.RowCount + ARowOffset;

    lDownsTop := AArea.Bottom-AArea.FooterRows-AArea.PageFooterRows-AArea.GroupFooterRows;
    CopyAreaSection(ASrcSheet,ADstSheet,Types.Rect(ALeft,lDownsTop,ARight,AArea.Bottom),
      ALeft, lDownsTop,ARowOffset);
  end;
  {决策区域输出}
  if Business.Forms.jsGrids.AreaClass2Type(AArea) = TAreaType.atDCArea then
  begin
    //决策数据集区域会遇到列偏移的问题
    raise Exception.Create('暂不支持决策数据集区域的输出!');
  end;
  {矩形区域输出}
  if Business.Forms.jsGrids.AreaClass2Type(AArea) = TAreaType.atRect then
  begin
    lMiddleTop := AArea.Top;
    for I := 0 to AArea.SubAreas.Count - 1 do
    begin
      lArea := AArea.SubAreas.Items[I];
      lMiddleBottom := lArea.Top - 1;
      CopyAreaSection(ASrcSheet, ADstSheet, Types.Rect(ALeft, lMiddleTop, ARight + 1, lMiddleBottom + 1),
        ALeft, lMiddleTop, ARowOffset);
      CopyArea(ASrcSheet, ADstSheet, lArea, ALeft, ARight, ARowOffset);
      lMiddleTop := lArea.Bottom;
    end;
    lMiddleBottom := AArea.Bottom;
    CopyAreaSection(ASrcSheet, ADstSheet, Types.Rect(ALeft, lMiddleTop, ARight + 1, lMiddleBottom + 1),
      ALeft, lMiddleTop, ARowOffset);
  end;
end;

********************************************************************************************)
//(******************************支持分组融合的新函数***************************************
static procedure TSHEETDOCLIB.CopyArea(ASrcSheet, ADstSheet: TSheet; AArea:TSheetArea;
  const ALeft, ARight: Integer; var ARowOffset: Integer);
var
  I, J, T: Integer;
  lUpsBottom, lDownsTop: Integer;
  lDataAreaHeight: Integer;
  lDataSet: TDataSet;
  lOutRecCount: Integer;
  lMiddleTop, lMiddleBottom: Integer;
  lArea: TSheetArea;

  lChangedGroup, lNonChangedGroup,
  lChangedGroupLine,
  lChangedGroupTop: integer;
  lGroupDefs: TSheetGroupDefs;
  lGroupValue: TGroupValue;
  lGroupValueList: TObjectList;

  lCol, lRow: integer;
  lLeft, lTop, lRight, lBottom,
  lGoupOutCount,
  lGoupOffset: integer;

  lStatistician: TDBSheetStatistician;
begin
  {数据集区域输出}
  if Business.Forms.jsGrids.AreaClass2Type(AArea) = TAreaType.atDBArea then
  begin
    lGroupValueList := TObjectList.Create;
    lStatistician := TDBSheetStatistician.Create(nil);
    lGoupOutCount := 0;
    lGroupDefs := TDataSheetArea(AArea).GroupDefs;
    lStatistician.Sheet := TDataSheet(ASrcSheet);
    lDataset := TDataSheet(ASrcSheet).FindDataSet(TDataSheetArea(AArea).DataSetDefID);
    {复制头部}
    lUpsBottom := AArea.Top + AArea.HeaderRows + AArea.PageHeaderRows + AArea.GroupHeaderRows;
    CopyAreaSection(ASrcSheet, ADstSheet, Types.Rect(ALeft, AArea.Top, ARight + 1,lUpsBottom),
      ALeft, AArea.Top, ARowOffset);

    if TDataSheetArea(AArea).PrintRange = TAreaPrintRange.aprAll then
    begin
      lOutRecCount := lDataSet.RecordCount;
      lDataSet.First;
    end
    else if TDataSheetArea(AArea).PrintRange = TAreaPrintRange.aprTopN then
    begin
      lOutRecCount := TDataSheetArea(AArea).TopNRecords;
      lDataSet.First;
    end
    else if TDataSheetArea(AArea).PrintRange = TAreaPrintRange.aprCurrent then
      lOutRecCount := 1
    else
      lOutRecCount := 0;
    lDataAreaHeight := TDataSheetArea(AArea).ClientHeight;
    {初始化分组字段值}
    for I := 0 to lGroupDefs.Count - 1 do
    begin
      lGroupValue := TGroupValue.Create;
      lGroupValue.FieldName := lGroupDefs.Items[I].GroupFieldName;
      lGroupValue.OldValue := lDataSet.FieldByName(lGroupValue.FieldName).AsString;
      lGroupValue.NewValue := lDataSet.FieldByName(lGroupValue.FieldName).AsString;;
      lGroupValue.Left := -1;
      lGroupValue.Top := -1;
      lGroupValue.Right := -1;
      lGroupValue.Bottom := -1;
      lGroupValue.Offset := 0;
      lGroupValue.Statistician := lStatistician;
      {仅能处理每个分组的一个融合}
      if lGroupDefs.Items[I].CellUnionDefs.Count > 0 then
      begin
        lGroupValue.Left := AArea.ClientRect.Left + lGroupDefs.Items[I].CellUnionDefs.Items[0].Col;
        lGroupValue.Top := AArea.ClientRect.Top;
        lGroupValue.Right := AArea.ClientRect.Right;
        lGroupValue.Bottom := AArea.ClientRect.Bottom;
      end;
      lGroupValueList.Add(lGroupValue);
    end;
    {初始化分组汇总值计算相关}
    for I := 0 to lGroupDefs.Count - 1 do
      lStatistician.ClearData(AArea, TStatType.stAll, I);
    InitExpr(ASrcSheet, AArea, lStatistician);

    repeat
      lMiddleTop := AArea.Top + AArea.HeaderRows + AArea.PageHeaderRows + AArea.GroupHeaderRows;
      for I := 0 to AArea.SubAreas.Count - 1 do
      begin
        lArea := AArea.SubAreas.Items[I];
        lMiddleBottom := lArea.Top ;
        CopyAreaSection(ASrcSheet, ADstSheet, Types.Rect(ALeft, lMiddleTop, ARight, lMiddleBottom),
          ALeft, lMiddleTop, ARowOffset);
        CopyArea(ASrcSheet, ADstSheet, lArea, ALeft, ARight, ARowOffset);
        lMiddleTop := lArea.Bottom;
      end;

      {分组支持}
      lNonChangedGroup := -1;
      lChangedGroup := -1;
      for I := 0 to lGroupValueList.Count - 1 do
      begin
        lGroupValue := TGroupValue(lGroupValueList[I]);
        lGroupValue.NewValue := lDataSet.FieldByName(lGroupValue.FieldName).AsString;
        if (lGroupValue.NewValue <> lGroupValue.OldValue) and (lNonChangedGroup = -1)then
        begin
          lNonChangedGroup := I;
          lChangedGroup := lGroupValueList.Count - lNonChangedGroup;
        end;
      end;
      if lChangedGroup > 0 then
      begin
        {复制组尾--}
        lChangedGroupLine := 0;
        for I := lNonChangedGroup to lGroupValueList.Count - 1 do
          lChangedGroupLine := lChangedGroupLine + lGroupDefs.Items[I].GroupFooterRows;
        if lChangedGroupLine > 0 then
        begin
          lChangedGroupTop := AArea.Bottom - AArea.FooterRows- AArea.PageFooterRows - lChangedGroupLine;
          CopyAreaSection(ASrcSheet, ADstSheet, Types.Rect(ALeft, lChangedGroupTop, ARight + 1, lChangedGroupTop + lChangedGroupLine),
            ALeft, lChangedGroupTop, ARowOffset - 1);{ -1 ??}
        end;
        ARowOffset := ARowOffset + lChangedGroupLine;
        {--复制组尾}
        if lChangedGroupLine > 0 then
          for I := lNonChangedGroup to lGroupValueList.Count - 1 do
          begin
            lGroupValue := TGroupValue(lGroupValueList[I]);
            lGroupValue.Top := lGroupValue.Top + lGroupValue.Offset;
            lGroupValue.Bottom := lGroupValue.Bottom + lGroupValue.Offset;
            lGroupValue.Offset := 1;
          end;
        {复制组头--}
        lChangedGroupLine := 0;
        for I := lNonChangedGroup to lGroupDefs.Count - 1 do
          lChangedGroupLine := lChangedGroupLine + lGroupDefs.Items[I].GroupHeaderRows;
        if lChangedGroupLine > 0 then
        begin
          lChangedGroupTop := lUpsBottom - lChangedGroupLine;
          CopyAreaSection(ASrcSheet, ADstSheet, Types.Rect(ALeft, lChangedGroupTop, ARight + 1, lChangedGroupTop + lChangedGroupLine),
            ALeft, lUpsBottom, ARowOffset);
        end;
        ARowOffset := ARowOffset + lChangedGroupLine;
        {--复制组头}
        if lChangedGroupLine > 0 then
          for I := lNonChangedGroup to lGroupValueList.Count - 1 do
          begin
            lGroupValue := TGroupValue(lGroupValueList[I]);
            lGroupValue.Top := lGroupValue.Top + lGroupValue.Offset;
            lGroupValue.Bottom := lGroupValue.Bottom + lGroupValue.Offset;
            lGroupValue.Offset := 1;
          end;
        {重置分组汇总初始值}
        for I := lNonChangedGroup to lGroupValueList.Count - 1 do
        begin
          lGroupValue := TGroupValue(lGroupValueList[I]);
          lGroupValue.Statistician.ClearData(AArea, TStatType.stGroup, I);
        end;
      end;
      lStatistician.ProcessRecord(AArea);{计算汇总值， 注意需要在分组输出后计算，否则分组的汇总值会出错。}
      {复制数据集区域中间部分（数据部分）}
      lMiddleTop := AArea.ClientRect.Top;
      lMiddleBottom := AArea.ClientRect.Bottom;
      CopyAreaSection(ASrcSheet, ADstSheet, Types.Rect(ALeft, lMiddleTop, ARight + 1, lMiddleBottom),
        ALeft, lMiddleTop, ARowOffset);
      lGoupOutCount := lGoupOutCount + 1;
      Dec(lOutRecCount);
      ARowOffset := ARowOffset + lDataAreaHeight;
      ADstSheet.RowCount := ASrcSheet.RowCount + ARowOffset;

      {融合分组单元格，或者刷新分组单元格值}
      for I := 0 to lGroupValueList.Count - 1 do
      begin
        lGroupValue := TGroupValue(lGroupValueList[I]);
        if (lGroupValue.NewValue = lGroupValue.OldValue) and (lGroupDefs.Items[I].CellUnionDefs.Count > 0) then
        begin
          lCol := lGroupDefs.Items[I].CellUnionDefs.Items[0].Col + AArea.Left;
          lRow := lGroupValue.Top;
          lBottom := lGroupValue.Bottom;
          lLeft := ADstSheet.Cells[lCol, lRow].Bounds.Left;
          lRight := ADstSheet.Cells[lCol, lRow].Bounds.Right;
          ADstSheet.Cells[lCol, lRow].Bounds := Types.Rect(lLeft, lRow, lRight, lBottom + lGroupValue.Offset);
          lGroupValue.Offset := lGroupValue.Offset + 1;
        end
        else
        begin
          for J := I to lGroupValueList.Count - 1 do
          begin
            lGroupValue := TGroupValue(lGroupValueList[J]);
            lGroupValue.OldValue := lGroupValue.NewValue;
            lGroupValue.Top := lGroupValue.Top + lGroupValue.Offset;
            lGroupValue.Bottom := lGroupValue.Bottom + lGroupValue.Offset;
            lGroupValue.Offset := 1;
          end;
          lChangedGroup := lGroupValueList.Count - I;
          break;
        end;
      end;
      lDataSet.Next;
      {测试用
      if lDataSet.RecNo > 3 then
        break;
      }
    until lDataSet.Eof or (lOutRecCount < 1);
    ARowOffset := ARowOffset - lDataAreaHeight;
    ADstSheet.RowCount := ASrcSheet.RowCount + ARowOffset;
    {复制尾部}
    lDownsTop := AArea.Bottom- AArea.FooterRows- AArea.PageFooterRows- AArea.GroupFooterRows;
    CopyAreaSection(ASrcSheet,ADstSheet,Types.Rect(ALeft, lDownsTop, ARight + 1, AArea.Bottom),
      ALeft, lDownsTop, ARowOffset);
    lGroupValueList.Free;
    lStatistician.Free;
  end;
  {决策区域输出}
  if Business.Forms.jsGrids.AreaClass2Type(AArea) = TAreaType.atDCArea then
  begin
    //决策数据集区域会遇到列偏移的问题
    raise Exception.Create('暂不支持决策数据集区域的输出!');
  end;
  {矩形区域输出}
  if Business.Forms.jsGrids.AreaClass2Type(AArea) = TAreaType.atRect then
  begin
    lMiddleTop := AArea.Top;
    for I := 0 to AArea.SubAreas.Count - 1 do
    begin
      lArea := AArea.SubAreas.Items[I];
      lMiddleBottom := lArea.Top - 1;
      CopyAreaSection(ASrcSheet, ADstSheet, Types.Rect(ALeft, lMiddleTop, ARight + 1, lMiddleBottom + 1),
        ALeft, lMiddleTop, ARowOffset);
      CopyArea(ASrcSheet, ADstSheet, lArea, ALeft, ARight, ARowOffset);
      lMiddleTop := lArea.Bottom;
    end;
    lMiddleBottom := AArea.Bottom;
    CopyAreaSection(ASrcSheet, ADstSheet, Types.Rect(ALeft, lMiddleTop, ARight + 1, lMiddleBottom + 1),
      ALeft, lMiddleTop, ARowOffset);
  end;
end;
//******************************************************************************************************)

static procedure TSHEETDOCLIB.CopyAreaSection(ASrcSheet, ADstSheet: TSheet; ARect: TRect;
  const ALeft, ATop, ARowOffset: Integer);
var
  I, J: Integer;
  s1: string;
begin
    ADstSheet.CopyClientSection(ASrcSheet, ARect, ALeft, ATop + ARowOffset,
      False, false, TOutProp.opAll, true);
    for I := 0 to ARect.Bottom - Arect.Top - 1 do
    begin
      ADstSheet.RowHeights[ATop + ARowOffset + I] := ASrcSheet.RowHeights[ATop + I];
      for J := 0 to ARect.Right - Arect.Left - 1 do
      begin
        s1 := sysUtils.Trim(ADstSheet.Cells[ALeft + J, ATop + ARowOffset + I].Text);
        if s1 = '' then
          ADstSheet.Cells[ALeft + J, ATop + ARowOffset + I].AsString := '';
      end;
    end;
end;

end.

alang

第8个表格数据太多且输出速度很慢，需要检查SQL语句的效率。
若只输出少量记录则会有1处断线（需要在Studio里重新设置一下就好了），
区域尾部和后一个区域头相交处有一行缺线（将区域高度增加一行即可）

dragonsoft

13报表导出出现得错误信息，造成没办法导出

dragonsoft

给我们新的代码解决了不少问题。
但是“页数自动增长”还没有解决。

alang

“页数自动增长”
这个是什么意思？

shl07

我测试了一下“13超计划投资项目一览表”报表输出到Excel：
超过12000条记录，能正确输出但时间较长。
可能是这个报表是不是修改过区域的设置，
您可以将那些报表所在的业务信息再打个包发过来，我们再测试一下！

alang

楼主，问题搞定没有？

alang

楼主，快五一了，你不是要五一前解决的吗，请尽快反馈，谢谢

dragonsoft

不好意思
现在报表还是存在几个问题：
1. 页数自动增长。 --自动增长的报表是改动过区域。
2. 带2个分组的报表是可以导出到excel，但如果2个分组都有合计的话，小分组的合计项在导出excel后会只有最后一组才有合计数字，其它分组的合计都没数字。
3. 有几个报表导出excel后字体是白色的(在表格文档中设置的颜色是黑色的)

资源包现在没办法提供，现在只能说明问题，请不要先结帖，谢谢。

alang

1 页数自动增长。 --自动增长的报表是改动过区域。
具体是什么问题，看不明白你的描述

3. 有几个报表导出excel后字体是白色的(在表格文档中设置的颜色是黑色的)
按照 http://bbs.justep.com/forum.php?mod=viewthread&tid=14895 的说明也不行吗？