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


    程序需要,需要将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:MySoftXESunsiDoc测试文档.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;
  • 相关阅读:
    js概念理解
    web性能瓶颈
    http协议
    jquery插件开发
    Razor(cshtml)
    从局域网内的其他Linux主机下载文件
    Java多线程学习笔记
    java中String s="abc"及String s=new String("abc")详解
    Object中toString方法
    DAO层,Service层,Controller层、View层、entity层
  • 原文地址:https://www.cnblogs.com/GarfieldTom/p/6860093.html
Copyright © 2020-2023  润新知