我在查找Word文档文本中“2017年8月16日”格式的任何日期时遇到问题。使用ActiveDocument.Content.Find,我只能在第一页上找到结果。即使在第一页内,结果也不一致。以下是我的代码。
Dim myMonth(1 To 12) As String
myMonth(1) = "January"
myMonth(2) = "February"
myMonth(3) = "March"
myMonth(4) = "April"
myMonth(5) = "May"
myMonth(6) = "June"
myMonth(7) = "July"
myMonth(8) = "August"
myMonth(9) = "September"
myMonth(10) = "October"
myMonth(11) = "November"
myMonth(12) = "December"
'Find and replace dates in MMMM dd, yyyy format
For i = 12 To 1 Step -1
With ActiveDocument.Content
With .Find
.Text = "(" & myMonth(i) & ")" & " ([0-9]{1,2}), ([0-9]{4})"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.MatchWildcards = True
End With
While .Find.Execute
.Text = CDate(.Text) + 7
.Text = Format(.Text, "mmmm d, yyyy")
Wend
.Find.MatchWildcards = False
End With
Next i
此代码以所述格式添加7天到任何日期。我试过循环遍历所有故事,结果是一样的。我已经能够以“08/16/2017”格式执行此任务的日期,所以问题似乎在于每个月的额外For循环。任何帮助将不胜感激。
答案 0 :(得分:0)
试试这段代码
Sub findMe()
Dim aaa As Find
Dim i As Integer
For i = 1 To 12
Debug.Print MonthName(i)
Set aaa = ActiveDocument.Range(Start:=1, End:=1).Find ' start at beginning of document
aaa.ClearFormatting
aaa.Replacement.ClearFormatting
aaa.Forward = True
aaa.Wrap = wdFindStop
aaa.Format = False
aaa.MatchCase = False
aaa.MatchWholeWord = False
aaa.MatchAllWordForms = False
aaa.MatchSoundsLike = False
aaa.MatchWildcards = True
aaa.Replacement.Text = ""
' search text starts with any character so that upper case and lower case words are found .... july July
aaa.Text = "?" & Mid(MonthName(i), 2, 20) & "[ ^t]{1,5}([0-9]{1,2}),[ ^t]{1,5}([0-9]{4})"
Do While True
DoEvents
If Not aaa.Execute Then Exit Do ' find next
Debug.Print aaa.Parent.Text ' found text
Debug.Print Format(aaa.Parent.Text, "mm/dd/yy") ' reformat date
Debug.Print DateAdd("d", 7, aaa.Parent.Text) ' add 7 days
Debug.Print Format(DateAdd("d", 7, aaa.Parent.Text), "mmmm dd, yyyy")
' aaa.Parent is the range object of the found text
' so you can do this ...
aaa.Parent.Text = Format(DateAdd("d", 7, aaa.Parent.Text), "mm/dd/yy")
aaa.Parent.Collapse Direction:=wdCollapseEnd ' point to "just after replaced text"
Loop
Next i
End Sub