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