在 vba 中，如何在当前选择中获取标题编号？

In vba how would I get the heading number at my Current selection?

提问by Snhp9

I have tried Everything I could find to get just the heading number for the Selection in Microsoft Word.

我已经尝试了所有我能找到的方法来获取 Microsoft Word 中选择的标题编号。

What I tried.

我试过的。

Selection.HomeKey wdline, wdExtend
Selection.Expand wdline
Selection.HomeKey wdParagraph, wdExtend
ect. Simular stuff.

Example of the heading.

标题示例。

4.2.3     This is a heading

Everything I try just gives me the text in the heading and not the number

我尝试的一切只是给了我标题中的文字而不是数字

I want it to return

我想要它回来

4.2.3

I cant convert the Documents Number to Text because it will mess with the spacing.

我无法将文档编号转换为文本，因为它会弄乱间距。

回答by Snhp9

I have solved my issue by using.

我已经通过使用解决了我的问题。

Selection.Paragraphs(1).Range.ListFormat.ListString

This gave me just the number.

这给了我号码。

Why a heading is a Paragraph??? I just don't know.

为什么标题是段落？？？我只是不知道。

回答by SMFSW

I had to deal with parsing of Word documents lately and needed to get headings numbers, found out paragraphs for Word increases after every line break.

我最近不得不处理 Word 文档的解析，需要获取标题编号，发现每次换行后 Word 的段落都会增加。

I made a script that parses word document & builds an array with: - text of the heading - paragraph number (as word understands it) - heading depth - reconctructed heading number

我制作了一个脚本来解析 word 文档并用以下内容构建一个数组： - 标题的文本 - 段落号（如单词所理解的） - 标题深度 - 重新构建的标题号

You can query with parGetStrgiving a paragraph number as param, the macro will return the heading number from the paragraph num given (ANSWERING THE FORMER QUESTION).

您可以使用parGetStr提供段落编号作为参数进行查询，宏将从给定的段落编号返回标题编号（ANSWERING THE FORMER QUESTION）。

parErasewill erase the table (needed if you made changes to the word headings and want to update the table as the array content is build only once when you use parGetStr).

parErase将擦除表格（如果您对单词标题进行了更改并希望更新表格，则需要在使用parGetStr时仅构建一次数组内容）。

parDrawis not really needed unless you want to show the table in a new document (for debug purposes for example) and rely on other scripts you would have to get (on my github too).

parDraw并不是真正需要的，除非您想在新文档中显示表格（例如出于调试目的）并依赖您必须获得的其他脚本（也在我的 github 上）。

You can find the latest scripts versions here: https://github.com/SMFSW/vbOffice

您可以在此处找到最新的脚本版本：https: //github.com/SMFSW/vbOffice

The "paragraphs" script will be extended and reworked soon. Here is the actual code for it:

“段落”脚本将很快得到扩展和重新设计。这是它的实际代码：

' paragraphs
' Get headings and build a table with text, line numbers, paragraph number & depth
' Version: 0.4
' Author: SMFSW, 2016
' Copyright: MIT
'

' TODO: Being able to handle modifications tracking (no count of deleted titles)
' TODO: Find the end of document another way (script may not work on some messy documents)
' TODO: Find a way to handle next heading find not going forward sometimes (which causes end of script)



' par (x, 0) : line in paragraph scale (full line to dot & carriage return / aka paragraph for Word)
' par (x, 1) : pargraph numbering output as string
' par (x, 2) : depth of heading
' par (x, 3) : text of heading
Private par(500, 3) As Variant
Private parCpt As Integer
Private parInit As Boolean


' erase content of global variables & array
Public Sub parErase()
    For i = 0 To 500
        For j = 0 To 3
            par(i, j) = ""
        Next j
    Next i
    parCpt = 0
    parInit = False
End Sub


' return paragraph number of range r
Public Function parGetNum(r As Range) As Double
    Dim rParagraphs As Range
    Dim CurPos As Double
    'If parInit = False Then Call parBuild  ' par tab not needed in parGetNum

    r.Select
    CurPos = ActiveDocument.Bookmarks("\startOfSel").Start
    Set rParagraphs = ActiveDocument.Range(Start:=0, End:=CurPos)
    parGetNum = rParagraphs.paragraphs.Count    ' USE NAME OF THE FUNCTION AS RETURN VALUE
End Function


' return paragraph number of range r as formated string
Public Function parGetStr(r As Range) As String
    Dim CurPos As Double
    Dim tmp As String: tmp = ""
    If parInit = False Then Call parBuild

    r.Select
    CurPos = parGetNum(r)
    For j = 0 To parCpt
        If par(j, 0) >= CurPos Then
            If j <> 0 Then
                tmp = par(j - 1, 1)
            Else
                tmp = 0 ' If before 1st Header, return 0
            End If

            Exit For    ' Exit when found
        End If
    Next j
    parGetStr = tmp
End Function


' add par table in a new document
Public Sub parDraw()
    Dim txtHeaders As Variant
    txtHeaders = Array("line", _
                       "chapter", _
                       "depth", _
                       "txt")

    savePerfContext ActiveDocument
    If parInit = False Then Call parBuild
    Call tabBuild(4, 0, par, txtHeaders)
    restorePerfContext ActiveDocument
End Sub


Private Sub parBuild()
    Dim maxDepth As Integer
    Dim cpt As Integer

    Dim flag As Boolean: flag = True
    Dim memStr As String

    ' parInit set to True before everything else so next calls to parGetXXX will not call parBuild again
    parInit = True

    ' move to the first heading (to determine text to strip for title depth)
    Selection.GoTo What:=wdGoToHeading, Which:=wdGoToFirst
    Selection.StartOf Unit:=wdParagraph
    Selection.MoveEnd Unit:=wdParagraph

    ' find how is called Title in your Word application
    Dim splt
    splt = split(Selection.Range.Style.NameLocal, " ")
    stripHeader = splt(0)
    Erase splt  ' erase temporary var splt

    ' move back to the start of the document
    Selection.HomeKey Unit:=wdStory

    'loop until the end of the document is reached
    parCpt = 0
    While flag = True
        Selection.GoTo What:=wdGoToHeading, Which:=wdGoToNext
        Selection.StartOf Unit:=wdParagraph
        Selection.MoveEnd Unit:=wdParagraph

        'get the line data
        strLine = Selection.Range.Text

        'check if the end of the document has been reached
        If memStr Like strLine Then flag = False
        memStr = strLine

        par(parCpt, 0) = parGetNum(Selection.Range)
        par(parCpt, 1) = "" ' init to empty str for later loop
        par(parCpt, 2) = Val(Replace(Selection.Range.Style.NameLocal, stripHeader, ""))
        par(parCpt, 3) = strLine

        ' Determining max depth of titles for later
        If par(parCpt, 2) > maxDepth Then maxDepth = par(parCpt, 0)

        ' Handling junk lines
        If parCpt <> 0 Then
            ' if depth par n-1 is equal to n's & line number from n-1 is right before n's
            If par(parCpt - 1, 2) = par(parCpt, 2) And par(parCpt - 1, 0) + 1 = par(parCpt, 0) Then
                ' copy to n-1 & don't incr parCpt
                par(parCpt - 1, 0) = par(parCpt, 0)
                par(parCpt - 1, 1) = par(parCpt, 1)
                par(parCpt - 1, 2) = par(parCpt, 2)
                par(parCpt - 1, 3) = par(parCpt, 3)
            Else: parCpt = parCpt + 1
            End If
        Else: parCpt = parCpt + 1
        End If
    Wend

    For i = 1 To maxDepth                   ' Applying paragraph numbers depth by depth
        cpt = 0                                 ' init at 0 so turns to 1 first time, which is what needed
        For j = 0 To parCpt
            If i > par(j, 2) Then cpt = 0           ' a sub paragraph end reached (resetting current and follow)
            If i = par(j, 2) Then cpt = cpt + 1     ' a new paragraph is reached (increment current and follow)
            If i <= par(j, 2) Then                  ' paragraph depth need to be added to sting
                If i <> 1 Then par(j, 1) = par(j, 1) & "."      ' dot added only if sub paragraph
                par(j, 1) = par(j, 1) & cpt                     ' append paragraph number to string in tab
            End If
        Next j
    Next i
End Sub