
批量为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