Блог

Я пытаюсь получить нумерованные местоположения моих закладок (номер абзаца без контекста) в документе Word (длинный шаблон юридического документа) и. В настоящее время я использую следующий код для извлечения текстовых значений с закладками из документа Word в книгу Excel, которую я создал, чтобы получить другие данные из других источников, но я не смог понять, как манипулировать кодом, чтобы захватить номера абзацев в закладках (я тоже искал их повсюду, и я новичок в VBA. Я знаю ровно столько, чтобы быть опасным, но недостаточно, чтобы быть полезным, лол). Пожалуйста, Помогите!

 Sub SectionLocationImportTESTING()
Dim intDocCount As Integer
Dim wdApp As Word.Application, wdDoc As Word.Document, xlWb As Excel.Workbook, xlWs As Excel.Worksheet
Dim BookmarkText As String

Set wdApp = GetObject(, "Word.Application")
On Error GoTo 0

If wdApp Is Nothing Then
    MsgBox "There are no MS Word Documents open.", vbInformation, "No Word Documents open"
    Exit Sub
End If

Set xlWb = ThisWorkbook
Set xlWs = ActiveWorkbook.Sheets("Data Input")
intDocCount = wdApp.Documents.Count

If intDocCount > 1 Then
    MsgBox "There are " amp; intDocCount amp; " Word Documents open." amp; vbNewLine amp; vbNewLine amp; _
    "Please close the additional MS Word Documents", vbCritical, "Too many Word Documents open!"
    Set wdApp = Nothing
    Exit Sub
End If

With wdApp
    Set wdDoc = wdApp.ActiveDocument
    wdDoc.Activate
    
'This is very abbreviated, I have about 300 bookmarks that transfer

If wdDoc.Bookmarks.Exists("Section_Rent") = True Then
    BookmarkText = wdDoc.Bookmarks("Section_Rent").Range.Text
xlWs.Cells(202, 22) = ("Section_Rent")
xlWs.Cells(202, 23) = BookmarkText
End If

End With

    ActiveWorkbook.RefreshAll
    ActiveSheet.PivotTables("Data_Input_Table").PivotFields("Trimmed Data"). _
    PivotFilters.Add2 Type:=xlCaptionIsGreaterThan, Value1:="0"
    

    Columns("D:D").EntireColumn.AutoFit
    Range("A1").Select

MsgBox "Transfer is complete."

End Sub
 

Я не думаю, что есть прямой способ сделать это.
Вы могли бы сделать это, например:

 Sub Tester()
    Debug.Print ParagraphNumber(Selection.Range)
End Sub


Function ParagraphNumber(rng As Range)
    ParagraphNumber = rng.Document.Range(0, rng.End).Paragraphs.Count
End Function
 

…но это также будет учитывать «пустые» абзацы.

Если у вас много закладок, вы можете просмотреть список имен на листе Excel, а затем выполнить цикл по этому диапазону для извлечения текста. Если вы жестко закодируете все эти имена в свой VBA, это будет очень сложно поддерживать.

Напр.

 '...
Dim c As Range, bm As String, rngBM As Word.Range

'...
'...

Set wdDoc = wdApp.ActiveDocument
wdDoc.Activate
'range with your bookmark names
Set rngBM = ThisWorkbook.Sheets("Bookmarks").Range("A2:A300")

For Each c In rngBM.Cells
    bm = c.Value 'bookmark name
    If wdDoc.Bookmarks.Exists(bm) Then
        Set rngBM = wdDoc.Bookmarks(bm).Range
        'for demo purposes just putting info next to the bookmark name...
        c.Offset(0, 1).Value = rngBM.Text
        c.Offset(0, 2).Value = ParagraphNumber(rngBM)
    End If
Next c
 

Есть 2 способа получить номер абзаца, в зависимости от того, что вы хотите:

Вариант 1

Это позволит получить точную строку автоматической нумерации, которую вы видите в самом абзаце:

Например, приведенный ниже абзац поможет вам 1.

1. Это тестовый абзац.

 If wdDoc.Bookmarks.Exists("Section_Rent") Then
    Dim BookmarkText As String
    BookmarkText = wdDoc.Bookmarks("Section_Rent").Range.Text
                    
    xlWs.Cells(202, 22) = "Section_Rent"
    xlWs.Cells(202, 23) = BookmarkText
            
    Dim BookmarkParaNum As String
    BookmarkParaNum = wdDoc.Bookmarks("Section_Rent").Range.ListFormat.ListString
    
    xlWs.Cells(202, 24) = BookmarkParaNum
End If
 

Вариант 2
Это приведет к получению строки, которую вы увидите, если вставите перекрестную ссылку на абзац:

Использование приведенного ниже кода для того же абзаца в варианте 1 даст вам то 1 же самое , что и вставка его в качестве перекрестной ссылки.

 wdDoc.Paragraphs.Last.Range.InsertParagraphAfter 'A temporary paragraph for inserting field later

Dim fieldRng As Range
Set fieldRng = wdDoc.Paragraphs.Last.Range.Duplicate

If wdDoc.Bookmarks.Exists("Section_Rent") Then
    Dim BookmarkText As String
    BookmarkText = wdDoc.Bookmarks("Section_Rent").Range.Text
                            
    xlWs.Cells(202, 22) = "Section_Rent"
    xlWs.Cells(202, 23) = BookmarkText
                            
    fieldRng.InsertCrossReference ReferenceType:="Bookmark", ReferenceKind:=wdNumberNoContext, ReferenceItem:="Section_Term", InsertAsHyperlink:=True, IncludePosition:=False, SeparateNumbers:=False, SeparatorString:=" "
    Dim tempField As Field
    Set tempField = fieldRng.Fields(1)
    
    Dim BookmarkParaNum As String
    BookmarkParaNum = tempField.Result
       
    xlWs.Cells(202, 24) = BookmarkParaNum
    
    tempField.Delete
End If

fieldRng.Delete 'Delete the temporary paragraph