批量处理word文件内容_VBA实践+批量为word合同模板表格填写内容

批量为word合同模板表格填写内容

在一个文档中，存在上千份相似的合同，需要在某个表格中固定的位置加上固定的内容。具体如下图所示，要在“承包方代表：”单元格的下方空白单元格中添加一些固定内容。

解决思路是，设置查找参数，找到符合条件的“承包方代表：”单元格，椐此单元格取得其下方单元格，如果这个单元格内容为空（包含多个空段的也是空），就写入固定内容。为了防止空格+段落标记这样的空内容存在的影响，在执行代码前，可以使用查找替换把段落标志前的一个或多个空格删除。

实现代码如下：

Sub 合同模板批量填写内容()
 
Dim i As Long, otal As Table, cell1 As Cell, cell2 As Cell
Selection.HomeKey wdStory '光标置于文首
 
'设置查找参数
Selection.Find.ClearFormatting '清除查找处格式
Selection.Find.Replacement.ClearFormatting '清除替换处格式
With Selection.Find
 .Text = "承包方代表：^13"
 .Replacement.Text = ""
 .Forward = True
 .Wrap = wdFindStop '查找到文档结尾时停止查找
 .MatchWildcards = True
End With
 
'开始查找，查找到“承包方代表：^13”时，则处理
Do While Selection.Find.Execute
 If Selection.Information(wdWithInTable) Then '判断查找内容在表格中
 Set cell1 = Selection.Cells(1)
 Set otal = Selection.Tables(1)
 Set cell2 = otal.Cell(cell1.RowIndex + 1, cell1.ColumnIndex)
 If cell2.Range.Paragraphs.Count = Len(cell2.Range) - 1 Then '单元格为空时(包含多个空段的情况)
 cell2.Range.Text = "其他单位：" & vbCrLf & vbCrLf & "2020年4月1日" '为查找内容所在单元格的下方单元格填写内容
 i = i + 1 '记录处理表格数量
 End If
 End If
 '把光标移动到下一个表格的开始处
 Selection.Move wdTable, 1
Loop
MsgBox "共处理" & i & "个表格"
End Sub