|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
以此为准!请测试》》》》》》》》》》》》》- Sub test()
- Dim myStart&, myDoc As Document, b As Boolean, Q As Range, R As Range, sr$
- Application.ScreenUpdating = False
- Set myDoc = ActiveDocument
- With myDoc.Content.Find
- Do While .Execute("^13[0-9]@[.、.]", , , -1, , , 0)
- With .Parent
- If Not b Then
- Set Q = myDoc.Range(.Start + 1, myDoc.Content.End)
- Set R = Q.Duplicate
- With R.Find
- .Font.ColorIndex = 6
- Do While .Execute("*", , , -1)
- If Not R.InRange(Q) Then Exit Do
- sr = sr & R.Text
- Loop
- With Q
- If sr <> "" Then
- .End = .End - 1: .InsertAfter "(" & sr & ")": sr = Empty
- End If
- End With
- End With
- b = True
- Else
- Set Q = myDoc.Range(.Start + 1, myStart)
- Set R = Q.Duplicate
- With R.Find
- .Font.ColorIndex = 6
- Do While .Execute("*", , , -1)
- If Not R.InRange(Q) Then Exit Do
- sr = sr & R.Text
- Loop
- With Q
- If sr <> "" Then
- .End = .End - 1: .InsertAfter "(" & sr & ")": sr = Empty
- End If
- End With
- End With
- End If
- myStart = .Start + 1: .Collapse
- End With
- Loop
- End With
- Application.ScreenUpdating = True
- MsgBox "ok!"
- End Sub
复制代码
|
|