表格文档导出到Excel的案例代码

Alice

unit MainForm;

interface

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

type
  TMainForm = class(TForm)
    FuncBroker: TFuncBroker;
    InfoBrokerYWXX2: TInfoBroker;
    ControlBar: TControlBar;
    DataNavigator: TDataNavigator;
    Panel: TPanel;
    DocViewYWXX2_JLST1: TDocView;
    Button1: TButton;
    DataSetBroker1: TDataSetBroker;
    procedure Button1Click(Sender: TObject);
    procedure BizFormShow(Sender: TObject);
    procedure DateTimePicker1Change(Sender: TObject);
  private
    {private declarations}
    procedure CopyInfoAreasToDstSheet(ASrcData: TInfo; ASrcSheet, ADstSheet: TSheet;  AAreas: TAreaList; var ALeft, ATop: Integer);
    procedure ExportToExcelFile(ADocViewList: TList);
  public
    {public declarations}
  end;

implementation


procedure TMainForm.Button1Click(Sender: TObject);
//begin
  // Close;
var
  lDocList: TList;
  lFileName: String;
begin
  lDocList := TList.Create;
  try
    lDocList.Add(DocViewYWXX2_JLST1);
    ExportToExcelFile(lDocList);
{    lFileName := jsSysUtils.GetSystemTempPath + 'JustepTemp.XLS';
    ExcelAccess.CellToExcel(INF_BGWDXX.TCEL_ZCBGWD(DocViewINF_BGWDXX_CEL_ZCBGWD.Doc).Sheet,
      lFileName);
    Borland.Delphi.ShellAPI.ShellExecute(Handle, 'Open', lFileName, '', '', Borland.Delphi.Windows.Sw_ShowNormal);
}  finally
    lDocList.Free;
  end;
end;

procedure TMainForm.ExportToExcelFile(ADocViewList: TList);
var
  lExcelExp: TExcelExporter;
  lOpenDialog: TOpenDialog;
  lAreaRows, lAreaCols, TempLeft, TempTop: Integer;
  lDstSheet, lSrcSheet: TSheet;
  lDstSheetArea, lSrcSheetArea: TSheetArea;
  I, J: Integer;
  TempStrList: TStringList;
  lInfo: TInfo;
  lDocView: TDocView;
const
  cLeft = 1;
  cTop = 5;
begin
  if ADocViewList = nil then
  begin
    Business.Forms.Dialogs.ShowMessage('生成Excel文件失败！没有对象传入');
    //MessageBox(0, '生成Excel文件失败！没有对象传入！', '提示框');
    Exit;
  end;

  try
    lOpenDialog := TSaveDialog.Create(nil);
    try
      lOpenDialog.Filter := 'Microsoft Excel Workbook(*.xls)|*.xls|All files (*.*)|*.*';
//      if lOpenDialog.Execute then
      begin
//        UseUnit('\TIB\USER\TIBDIALOG.PAS');
        try
          //showmessage('正在生成Excel文件，请等待....');
        //   Business.Forms.Dialogs.ShowMessage('正在生成Excel文件，请等待....');
        //  lDstSheet := TSheetDoc(DocView1.Doc).Sheet;
          lDstSheet := TSheet.Create(nil);
//          lExcelExp := TExcelExporter.Create(nil);
          try
              //lSrcSheet := ASrcSheet;//;TempDocView.Doc.DocObject;
            TempLeft := cLeft;

            for I := 0 to ADocViewList.Count - 1 do
            begin
              lDocView := ADocViewList[I] as TDocView;
              lInfo := lDocView.InfoBroker.Info;
              lSrcSheet := TSheetDoc(lDocView.Doc).Sheet;

              //把第一个Docview中的sheet的基本属性应用到整个目标Sheet中
              if I = 0 then
              begin
                if lSrcSheet.Areas.Count > 0 then   //为了确保lSrcSheetArea能够得到赋值
                  lSrcSheetArea := lSrcSheet.Areas[0]
                else
                begin
                   Business.Forms.Dialogs.ShowMessage('表单没有定义数据区域');
                 // MessageBox(0, '表单没有定义数据区域！', '错误');
                  Exit;
                end;
                lDstSheet.SheetProperty.UnitType := lSrcSheet.SheetProperty.UnitType;//mmPixel;
                lDstSheet.ColDefWidth := lSrcSheet.ColDefWidth + 15;  // 复制默认列宽
                lDstSheet.RowDefHeight := lSrcSheet.RowDefHeight;     // 复制默认行高
                lDstSheet.ColCount := lSrcSheet.ColCount;
                for J := 0 to lSrcSheet.ColCount - 1 do
                  lDstSheet.ColWidths[J] := lSrcSheet.ColWidths[J];
                for J := 0 to lSrcSheetArea.Top - 1 do  //标题
                  lDstSheet.RowHeights[J] := lSrcSheet.RowHeights[J];



                lDstSheet.RowCount := lSrcSheetArea.Top;

                TempLeft := cLeft;
                TempTop := lSrcSheetArea.Top;
                //拷贝头：第一个Sheet的从1到3行作为生成Excel后的头
               lDstSheet.CopyClientSection(lSrcSheet, Classes.Rect(0, 0, lSrcSheetArea.Top-1, lSrcSheetArea.Right), 0, 0, False, False, TOutProp.opAll, True);

              end;

//              ReFreshFrm;
              CopyInfoAreasToDstSheet(lInfo, lSrcSheet, lDstSheet, lSrcSheet.Areas, TempLeft, TempTop);
            end;

            lExcelExp := TExcelExporter.Create(lDstSheet);
//            lExcelExp. Sheet := lDstSheet;
            lExcelExp.ExportToFile('C:\aa.xls');//lOpenDialog.FileName);
          finally
            lDstSheet.Free;
            lExcelExp.Free;
          end;
          //CloseDialog;
        finally
         // UnLoadUnit('\TIB\USER\TIBDIALOG.PAS');
        end;
      end;
    finally
      lOpenDialog.Free;
    end;
  except
//    MessageBox(0, '生成Excel文件失败！错误信息：'+ ExceptionMessage, '提示框', MB_OK + MB_ICONINFORMATION);
    Exit;
  end;
//  MessageBox(0, '生成Excel文件成功！', '提示框', MB_OK + MB_ICONINFORMATION);
end;

procedure TMainForm.CopyInfoAreasToDstSheet(ASrcData: TInfo; ASrcSheet, ADstSheet: TSheet;
  AAreas: TAreaList; var ALeft, ATop: Integer);
var
  I, J, lLeft, lTop, TempLeft, TempRight, TempCount, lOldRowCount: Integer;
  lDataset: TDataset;
  TempArea, lNextArea, lEndArea, lSubArea: TSheetArea;
  lIsNullDataset: Boolean;
begin
  AAreas.SortAreaBounds;
  for I := 0 to AAreas.Count - 1 do
  begin
    TempArea := AAreas[I];
    //考虑到页头区域等没有数据集的区域，就直接copy过来。
    if not (TempArea is TDataSheetArea) then
    begin
      //***************考虑页头区域等没有数据集的区域*********************//
      TempCount := TempArea.Bottom - TempArea.Top;
         //设置每行的行高
      lOldRowCount := ADstSheet.RowCount;
      ADstSheet.RowCount := ADstSheet.RowCount + TempCount;
      for J := 0 to TempCount - 1 do
        ADstSheet.RowHeights[lOldRowCount + J] := ASrcSheet.RowHeights[TempArea.Top + J];

      TempLeft := TempArea.Left;
      TempRight := TempArea.Right;
      ADstSheet.CopyClientSection(ASrcSheet, Types.Rect(TempLeft, TempArea.Top, TempRight, TempArea.Bottom), ALeft, ATop, False, False, TOutProp.opAll, False);
      ATop := ATop + TempCount;
    end
    else
    begin
      //按数据集的记录数添加区域
      lDataset := ASrcData.DatasetByID((TempArea as TDataSheetArea).DataSetDefID);
      lDataset.First;
      if lDataset.Eof then
        lIsNullDataset := True
      else
        lIsNullDataset := False;

      ADstSheet.CopyClientSection(ASrcSheet, TempArea.TopFixRect, ALeft, ATop, False, False, TOutProp.opAll, False);
      ATop := ATop + TempArea.TopFixRows;

      while (not lDataset.Eof) or lIsNullDataset do
      begin
        lIsNullDataset := False;
        //***************拷贝当前区域中当前区域的头到第一个子区域头的部分********//
        if TempArea.SubAreas.Count > 0 then
        begin
          lSubArea := TempArea.SubAreas[0];
             //设置每行的行高
          TempCount := lSubArea.Top - TempArea.Top;
          lOldRowCount := ADstSheet.RowCount;
          ADstSheet.RowCount := ADstSheet.RowCount + TempCount;
          for J := 0 to TempCount - 1 do
            ADstSheet.RowHeights[lOldRowCount + J] := ASrcSheet.RowHeights[TempArea.Top + J];

          ADstSheet.CopyClientSection(ASrcSheet, Types.Rect(TempArea.Left, TempArea.Top, TempArea.Right, lSubArea.Top), ALeft, ATop, False, False, TOutProp.opAll, False);
          ATop := ATop + TempCount;//只设置了top， 没有设置left
          CopyInfoAreasToDstSheet(ASrcData, ASrcSheet, ADstSheet, TempArea.SubAreas, ALeft, ATop);
          //**********************************************************//
        end else
        begin
          //******如果没有子区域，那么就把当前区域拷贝过去*********//
          TempCount := TempArea.ClientHeight;
             //设置每行的行高
          lOldRowCount := ADstSheet.RowCount;
          ADstSheet.RowCount := ADstSheet.RowCount + TempCount;
          for J := 0 to TempCount - 1 do
            ADstSheet.RowHeights[lOldRowCount + J] := ASrcSheet.RowHeights[TempArea.Top + J];

          if Assigned(TempArea.ParentArea) then
          begin
            TempLeft := TempArea.ParentArea.Left;
            TempRight := TempArea.ParentArea.Right;
          end else
          begin
            TempLeft := TempArea.Left;
            TempRight := TempArea.Right;
          end;
          ADstSheet.CopyClientSection(ASrcSheet, TempArea.ClientRect{ Types.Rect(TempLeft, TempArea.Top, TempRight, TempArea.Bottom)}, ALeft, ATop, False, False, TOutProp.opAll, False);
          ATop := ATop + TempCount;
          //**********************************************************//
        end;

        lDataset.Next;
      end;
      //********copy 两个同级区域之间的空间（当前区域下的主区域的空间)**********//
      if I < AAreas.Count - 1 then
      begin
        lNextArea := AAreas[I+1];
        if TempArea.Bottom < lNextArea.Bottom then
        begin
          TempCount := lNextArea.Top - TempArea.Bottom;
             //设置每行的行高
          lOldRowCount := ADstSheet.RowCount;
          ADstSheet.RowCount := ADstSheet.RowCount + TempCount;
          for J := 0 to TempCount - 1 do
            ADstSheet.RowHeights[lOldRowCount + J] := ASrcSheet.RowHeights[TempArea.Bottom + J];

          if Assigned(TempArea.ParentArea) then
          begin
            TempLeft := TempArea.ParentArea.Left;
            TempRight := TempArea.ParentArea.Right;
          end else
          begin
            TempLeft := TempArea.Left;
            TempRight := TempArea.Right;
          end;
          ADstSheet.CopyClientSection(ASrcSheet, Types.Rect(TempLeft, TempArea.Bottom, TempRight, lNextArea.Top), ALeft, ATop, False, False, TOutProp.opAll, False);
          ATop := ATop + TempCount;
        end;
      end
      //**********************************************************//
      //********拷贝最后一个子区域到当前区域末的当前区域的部分**************//
      else if I = AAreas.Count - 1 then
      begin
        lEndArea := AAreas[AAreas.Count - 1];
        if Assigned(lEndArea.ParentArea) and (lEndArea.Bottom < lEndArea.ParentArea.Bottom) then
        begin
          TempCount := lEndArea.ParentArea.Bottom - lEndArea.Bottom;
             //设置每行的行高
          lOldRowCount := ADstSheet.RowCount;
          ADstSheet.RowCount := ADstSheet.RowCount + TempCount;
          for J := 0 to TempCount - 1 do
            ADstSheet.RowHeights[lOldRowCount + J] := ASrcSheet.RowHeights[lEndArea.Bottom + J];

          ADstSheet.CopyClientSection(ASrcSheet, Types.Rect(lEndArea.ParentArea.Left, lEndArea.Bottom, lEndArea.ParentArea.Right, lEndArea.ParentArea.Bottom), ALeft, ATop, False, False, TOutProp.opAll, False);
          ATop := ATop + TempCount;
        end;
      end;
      //**********************************************************//
    end;
  end;
end;


end.

Alice

如上只是一个案例，而不是通用的方法，需要根据实际的情况调整代码实现这个功能