在vba中，我如何获得当前选择的标题号？

Question

我已经尝试了一切我能找到的东西，只得到Microsoft Word中选择的标题号。

我尝试了什么。

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

标题示例。

4.2.3     This is a heading

我尝试的所有内容都只给出了标题中的文字而不是数字

我希望它返回

4.2.3

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

Answer 1

我已经使用。

解决了我的问题

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

这给了我一个数字。

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

Answer 2

我最近不得不处理Word文档的解析，需要获取标题数字，找到每个换行后Word增加的段落。

我制作了一个解析word文档和脚本的脚本。构建一个数组： - 标题的文本 - 段号（正如单词理解） - 航向深度 - 重新划定的航向号

您可以使用 parGetStr 进行查询，并将段落编号作为参数，宏将返回给定的段落编号中的标题编号（ 回答问题 < /强>）。

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

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

parDraw 。

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

“paragraph”脚本将很快扩展并重新编写。 以下是它的实际代码：

' 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