N多个表格后面批量添加相同文字

niangjiudishito

这个问题是朋友问我的，我不会，在这里请求大家赐教！
有个word文件（见附件），有一千多页，里面有很多个表格，现在要在每个表格后面紧接着写上：“拟稿（签名）：          核稿（签名）：          审批（签名）：             年  月  日”，（在附件里用红色字体标识了），因为表格太多，如果用粘贴复制的方法太繁琐了，我估摸着是用vba来做，但是自己水平有限，代码不熟悉，请大家给予指导。非常感谢！

guojianlin1985

偶也来参观学习

gl_zhangt

引玉抛砖哦
Sub adHang()
Dim i As Long
Dim txt
txt = "拟稿（签名）：          核稿（签名）：          审批（签名）：             年  月  日" & vbCrLf
    With ActiveDocument
        For i = 1 To .Tables.Count
            .Tables(i).Select
            With Selection
                .Collapse Direction:=wdCollapseEnd
                .InsertAfter txt
                .Collapse Direction:=wdCollapseStart
            End With
        Next
    End With
   
End Sub

niangjiudishito

经过测试通过了吗？非常感谢

szqhb

原帖由 gl_zhangt 于 2010-9-4 11:14 发表
引玉抛砖哦
Sub adHang()
Dim i As Long
Dim txt
txt = "拟稿（签名）：          核稿（签名）：          审批（签名）：             年  月  日" & vbCrLf
    With ActiveDocument
        For i = 1 To  ...

若在表前插入文字又要如何修改代码？？？？？

守柔

原帖由 szqhb 于 2010-9-5 01:05 发表

若在表前插入文字又要如何修改代码？？？？？

Option Explicit

Sub Example()
    TableInsertText True
End Sub

Private Sub TableInsertText(blnBefore As Boolean)
    Dim oTable As Table
    Dim rngTable As Range
    Dim strInsert As String
    Application.ScreenUpdating = False
    strInsert = "拟稿（签名）：          核稿（签名）：          审批（签名）：             年  月  日"
    Select Case blnBefore
    Case True
        For Each oTable In ActiveDocument.Tables
            Set rngTable = oTable.Range
            rngTable.Collapse wdCollapseStart
            rngTable.Select
            Selection.SplitTable
            Selection.InsertAfter strInsert
        Next
    Case False
        For Each oTable In ActiveDocument.Tables
            Set rngTable = oTable.Range
            rngTable.Collapse wdCollapseEnd
            rngTable.InsertAfter strInsert & Chr$(13)
        Next
    End Select
    Application.ScreenUpdating = True
End Sub

szqhb

非常感谢守柔大师

gl_zhangt

通用性强，非常感谢守柔大师!

tangqingfu

收藏备用，谢谢分享！

czbdj

收藏备用，谢谢分享！