起步软件技术论坛-X3

 找回密码
 立即注册
搜索
查看: 1501|回复: 0

如何把一个表格文档保存成EXCEL

[复制链接]
发表于 2004-5-25 15:34:54 | 显示全部楼层 |阅读模式
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;
      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.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];

          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.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;

//以两种方式来生成到Excel(树节点、DocView)
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
    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文件,请等待....');
          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
                  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, Rect(0, 0, lSrcSheetArea.Top-1, lSrcSheetArea.Right), 0, 0, False, False);
              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.Button2Click(Sender: TObject);
var
  lDocList: TList;
  lFileName: String;
begin
  lDocList := TList.Create;
  try
    lDocList.Add(DocViewINF_BGWDXX_CEL_ZCBGWD);
    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;
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

小黑屋|手机版|Justep Inc.

GMT+8, 2024-12-23 04:46 , Processed in 0.037214 second(s), 15 queries .

Powered by Discuz! X3.4

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表