Sub test() Dim myRange As Range Dim num as String, title as String
'Set ps = Selection.Bookmarks(\headinglevel).Range.Paragraphs Set ps = ActiveDocument.Bookmarks(\headinglevel).Range.Paragraphs For Each p In ps Set myRange = p.Range num = myRange.ListFormat.ListString title = myRange.Text MsgBox 编号: & num & vbCrLf & 标题内容: & title Next p
'Set myRange = Selection.Bookmarks(\headinglevel).Range.Paragraphs(1).Range 'MsgBox 编号: & myRange.ListFormat.ListString & vbCrLf & 标题内容: & myRange.Text End Sub
另外附上一段把标题(Heading)序号取出并附加在标题内容后面的代码:
Sub ReplaceHeadingContent() Dim myRange As Word.Range Dim num As String, content As String
'取得所有书签 Set ps = ActiveDocument.Bookmarks(\headinglevel).Range.Paragraphs
'对书签中每一个段落进行处理 For Each p In ps Set myRange = p.Range
With myRange '把Range结束范围往前移一个字符,目的是为了不包括换行符 .MoveEnd Unit:=wdWord, Count:=-1
'取出段落序号 num = Trim(.ListFormat.ListString)
'取出Heading的内容 content = Trim(.Text)
'如果段落序号不为空,则把段落序号取出附加的标题内容后面 If Trim(num) Then If num = 1.1.1.1.1. Or num = 1.1.1.1.1 Then MsgBox 到目标点了。 End If
If Right(num, 1) = . Then num = Left(num, Len(num) - 1) '不需段落序号最后面的“.” .Text = content & & num & End If 'MsgBox 编号: & num & vbCrLf & 标题内容: & content End With Next p End Sub