您的位置:首页 > 编程语言 > Delphi

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

2017-05-16 10:26 471 查看
程序需要,需要将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;
内容来自用户分享和网络整理,不保证内容的准确性,如有侵权内容,可联系管理员处理 点击这里给我发消息
标签: