如何用VBA取得Word文档中的标题前面的序号

遇到一个小需求，需要提取Word文档标题前面的序号，例如：

/**************举例文档*******************/
1. 一级标题1   /*一级标题的编号+标题内容，编号可能是系统内置编号样式，也可能是用户
                         *自定义的样式*/
  段落2              /*文档内容段落2，标题1占用一个段落，此处为2*/                    
  段落3             /*文档内容段落3*/  
1.1 二级标题1.1       /*多级符号+二级标题，编号样式为内置或用户自定义样式*/
  段落5
  段落6
1.2 二级标题1.2
  段落8
2. 一级标题2
  段落10
2.1 二级标题2.1
2.1.1 三级标题2.1.1
  段落13
/**************举例文档结束**************/

需要提取到:

1

1.1

1.2

2

2.1

2.1.1

这些序号，搜索+研究了一下，找到了一方法，顺手记录一下，免得再次摔跤。

 

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

 

 

评论

1 楼 withthewind 2018-09-20  

终于找到一个可以用的了。。。