求助：如何才能更加精确的查找执行呢？

bylandi · 发表于 2024-12-23 09:26

上面，蜀中兄弟的代码几乎完美了
但是，目前尚有一个问题，就是表格下方的序号，无法被执行到。

虽然，我也通过其他土办法解决了我原来代码的问题，但还是希望能研究清楚，蜀中兄弟代码的问题。

bylandi · 发表于 2024-12-23 09:41

以下是代码文字版，哪位兄弟有空的话，可以帮试试看是什么问题。

Sub A自动转换()
Dim 段落 As Paragraph, 正 As Object, i As Byte, 字符 As Long, 范围 As Range, 内容 As Range
Set 正 = CreateObject("vbscript.regexp")
arr = Array("^\d+\.\d+[^\.0-9]", "^\d+\.\d+\.\d+[^\.0-9]", "^\d+\.\d+\.\d+\.\d+[^\.0-9]", "^\d+\.\d+\.\d+\.\d+\.\d+[^\.0-9]")
brr = Array(wdStyleHeading2, wdStyleHeading3, wdStyleHeading4, wdStyleHeading5)
'=========move方法学习冬瓜老师的方法=========
With Selection
Set 内容 = IIf(.Type = wdSelectionIP Or .Type = wdNoSelection, ActiveDocument.Content, .Range)
End With
With ActiveDocument
With .Range(内容.Start, 内容.Start)
Do While .End < 内容.End - 1
'=========跳过表格=========
If .Information(12) Then
.Expand 15: .Move
Else
Set 段落 = .Paragraphs(1)
For i = LBound(arr) To UBound(arr)
With 正
.Pattern = arr(i): .Global = True
.IgnoreCase = False: .MultiLine = True
If .test(段落.Range.Text) Then
段落.Range.ParagraphFormat.Style = brr(i)
'=========删除原来的编号=========
Set match = .Execute(段落.Range.Text)(0)
字符 = Len(match)
Set 范围 = 段落.Range
范围.SetRange 范围.Start, 范围.Start + 字符 - 1
范围.Delete
End If
End With
Next
End If
.Move 4
Loop
End With
End With
End Sub

复制代码

batmanbbs · 发表于 2024-12-23 18:43

bylandi · 发表于 2024-12-23 19:45

大神哦，一眼就看出了问题所在。
问题终于解决了。
感谢几位大神的耐心指点与帮助。

		自动登录	找回密码
密码			免费注册

[求助] 求助：如何才能更加精确的查找执行呢？