怎么实现日期填写

Joker14141

怎样实现WORD文档里面第二行里的检测日期填写到最下面一行的日期里面？WORD里面日期有好多，感谢感谢！新手

duquancai

Sub tert()
    Dim t$, tr$, i%, n%, m%, arr1, arr2
    arr1 = Array("检测人：" & Chr(13) & "级别：Ⅱ" & Chr(13), "审核人：" & Chr(13) & "级别：Ⅱ" & Chr(13), _
    "检测单位：（盖章）" & Chr(13), "监理工程师（签字）" & Chr(13))
    arr2 = Array("检测人：", "审核人：")
    tr = ActiveDocument.Tables(1).Rows(2).Cells(1).Range.Text
    With ActiveDocument
        For n = 1 To .Tables.Count
            m = m + 1
            t = .Tables(n).Rows(2).Cells(1).Range.Text
            If .Tables(n).Rows(2).Cells(1).Range.Text <> tr Then
                t = .Tables(m - 1).Rows(2).Cells(2).Range.Text
                For i = 1 To .Tables(n).Rows(.Tables(n).Rows.Count).Cells.Count
                    .Tables(n).Rows(.Tables(n).Rows.Count).Cells(i).Range = arr2(i - 1) & t
                Next
            Else
                t = .Tables(n).Rows(2).Cells(2).Range.Text
                For i = 1 To .Tables(n).Rows(.Tables(n).Rows.Count).Cells.Count
                    .Tables(n).Rows(.Tables(n).Rows.Count).Cells(i).Range = arr1(i - 1) & t
                Next
            End If
        Next
    End With
End Sub

kqbt

供测试：

1. Sub DatesBatchCopy()
   
2.   Dim I As Integer, N As Integer
   
3.   Dim TBA As Table, TBB As Table, DT As String
   
4.   For I = 1 To ActiveDocument.Tables.Count Step 2
   
5.     Set TBA = ActiveDocument.Tables(I)
   
6.     Set TBB = ActiveDocument.Tables(I + 1)
   
7.     DT = TBA.Rows(2).Cells(2).Range
   
8.     DT = Left(DT, Len(DT) - 1)
   
9.     With TBA.Rows.Last.Range.Find
   
10.       .ClearFormatting
    
11.       .Replacement.ClearFormatting
    
12.       .Execute "([^13^32]@)年^32@月^32@日", , , True, , , , , , "\1" & DT, wdReplaceAll
    
13.     End With
    
14.     With TBB.Rows.Last.Range.Find
    
15.       .Execute "([^13^32]@)年^32@月^32@日", , , True, , , , , , "\1" & DT, wdReplaceAll
    
16.     End With
    
17.   Next
    
18. End Sub

复制代码

duquancai

kqbt 发表于 2016-7-7 12:43
供测试：

版主您好，您这又高级多了！力挺您！

QQ214189912

象质计  应该是 像

Joker14141

duquancai 发表于 2016-7-6 02:26
Sub tert()
    Dim t$, tr$, i%, n%, m%, arr1, arr2
    arr1 = Array("检测人：" & Chr(13) & "级别： ...

感谢感谢 万分感谢

Joker14141

kqbt 发表于 2016-7-7 12:43
供测试：

感谢各位大大！新手感谢了