• 设为首页
  • 点击收藏
  • 手机版
    手机扫一扫访问
    迪恩网络手机版
  • 关注官方公众号
    微信扫一扫关注
    公众号

Delphi读取不Word中不规则表格数据并转换成标准表格

原作者: [db:作者] 来自: [db:来源] 收藏 邀请

程序需要,需要将word中不规则的表格数据转换为标准的表格,即合并的单元格按正常格式解析,word中的表格格式如下:

 

解析后数据如下:

 

 

借鉴了网上代码,如下处理:

 

procedure TfrmMain.getWordCellStr;
var
  WordApp: TWordApplication;
  WordDoc: TWordDocument;
  DocInx,oFileName,CfCversions,oReadOnly,AddToRctFiles,PswDocument,
  PswTemplate,oRevert,WPswDocument,WPswTemplate,oFormat: OleVariant;
  i,j,m,n,iRow,iCol,iHide,iMaxCol,iCurWidth,iStandardWith:integer;
  myCell:Cell;
  myRow:Row;

  StandardWidthArr: array of Integer; //动态数组定义时不与维数
  RowWidthArr: array of Integer; //动态数组定义时不与维数
  RowContentArr: array of String; //动态数组定义时不与维数
begin
  memLog.Lines.Clear ;
  // ===== 创建对象 =====
  if not Assigned(WordApp) then
  begin
    WordApp:= TWordApplication.Create(nil);
    WordApp.Visible := false;
  end;
  if not Assigned(WordDoc) then
    WordDoc:= TWordDocument.Create(nil);

  try
    DocInx:=1;
    oFileName := 'E:\MySoftXE\Sunsi\Doc\测试文档.docx';
    oReadOnly:=true;
    CfCversions := EmptyParam;
    AddToRctFiles:= EmptyParam;
    PswDocument:= EmptyParam;
    PswTemplate:= EmptyParam;
    oRevert:= EmptyParam;
    WPswDocument:= EmptyParam;
    WPswTemplate:= EmptyParam;
    oFormat:= EmptyParam;
    // ===== 打开文件 =====
    WordApp.Documents.open(oFileName,CfCversions,oReadOnly,AddToRctFiles,
       PswDocument,PswTemplate,oRevert,WPswDocument,WPswTemplate,oFormat,EmptyParam,EmptyParam);
    // ===== 关联文件 =====
    WordDoc.ConnectTo(WordApp.Documents.Item(DocInx));

    For i := 1 To WordDoc.Tables.Count do              //第 i 个表
    begin

      SetLength(StandardWidthArr,WordDoc.Tables.Item(i).Rows.Count); //分配6个元素位置: 0-5

      For iRow := 1 To WordDoc.Tables.Item(i).Rows.Count do
      begin
        iMaxCol:=WordDoc.Tables.Item(i).Columns.Count;
        myRow:=WordDoc.Tables.Item(i).Rows.Item(iRow);//第 iRow 行
        //保存第一行的行宽定义
        if iRow=1 then
        begin
          For icol := 1 To myRow.Cells.Count do         //第 iCol列
          begin
            myCell:= myRow.Cells.Item(iCol) ;
            StandardWidthArr[icol-1]:=Trunc(myCell.Width);
          end;
        end;

        //列数相同
        if myRow.Cells.Count=iMaxCol then
        begin
          for iCol := 1 to myRow.Cells.Count do
          begin
             myCell:= myRow.Cells.Item(iCol) ;
            grdTest.Cells[iCol,iRow]:=StringReplace(myCell.Range.Text,#$D#7,'',[rfReplaceAll]);
          end;
        end
        else
        begin
          //遍历
          iCurWidth:=0;
          iHide:=0;
          SetLength(RowWidthArr,myRow.Cells.Count);
          SetLength(RowContentArr,myRow.Cells.Count);

          //取出本行数据
          For iCol := 1 To myRow.Cells.Count do
          begin
            myCell:= myRow.Cells.Item(iCol) ;
            RowWidthArr[iCol-1]:=Trunc( myCell.Width );
            RowContentArr[iCol-1]:=StringReplace(myCell.Range.Text,#$D#7,'',[rfReplaceAll]);
          end;

          iStandardWith:=0;
          iCurWidth:=0;
          iHide:=0;
          for iCol := 1 to myRow.Cells.Count do
          begin
            iStandardWith:=iStandardWith+StandardWidthArr[iCol-1];
            iCurWidth:=iCurWidth+RowWidthArr[iCol-1];
            if abs(iStandardWith-iCurWidth)<10 then
            begin
              grdTest.Cells[iCol+iHide,iRow]:=RowContentArr[iCol-1];
            end
            else
            begin
              grdTest.Cells[iCol+iHide,iRow]:=RowContentArr[iCol-1];
              while (abs(iStandardWith-iCurWidth)>10) do
              begin
                iHide:=iHide+1;
                iStandardWith:=iStandardWith+StandardWidthArr[iCol-1+iHide];
                grdTest.Cells[iCol+iHide,iRow]:=RowContentArr[iCol-1];
              end;
            end;
          end;
        end;
      end;
    end;

  finally
    if Assigned(WordDoc) then              // ===== 关闭文件 =====
    begin
      WordDoc.Close;
      WordDoc.Disconnect;
      WordDoc.Destroy;
      WordDoc := nil;
    end;
    if Assigned(WordApp) then              // ===== 关闭Word =====
    begin
      WordApp.Quit;
      WordApp.Disconnect;
      WordApp.Destroy;
      WordApp := nil;
    end;
  end;
end;

 


鲜花

握手

雷人

路过

鸡蛋
该文章已有0人参与评论

请发表评论

全部评论

专题导读
上一篇:
Delphi高效的字符串处理发布时间:2022-07-18
下一篇:
Delphi新手跟我学写CALL,附完整原程序发布时间:2022-07-18
热门推荐
阅读排行榜

扫描微信二维码

查看手机版网站

随时了解更新最新资讯

139-2527-9053

在线客服(服务时间 9:00~18:00)

在线QQ客服
地址:深圳市南山区西丽大学城创智工业园
电邮:jeky_zhao#qq.com
移动电话:139-2527-9053

Powered by 互联科技 X3.4© 2001-2213 极客世界.|Sitemap