Как распечатать список закладок в документе Word?

Пробовали ли вы когда-нибудь распечатать список закладок в документе Word? Ниже мы расскажем, как это сделать.

Извлечение всех закладок и печать с помощью VBA

Прямая печать всех закладок с помощью VBA

---

Извлечение всех закладок и печать с помощью VBA

Приведённый ниже код VBA извлечёт все закладки из текущего документа в новый документ, после чего вы сможете вручную распечатать их по своему усмотрению. Выполните следующие действия.

1. Откройте документ, закладки из которого вы хотите распечатать, и нажмите клавиши Alt+F11, чтобы открыть окно Microsoft Visual Basic for Applications.

2. В окне Microsoft Visual Basic for Applications выберите Вставка > Модуль, затем скопируйте приведённый ниже код в окно модуля.

Код VBA: извлечение всех закладок в новый документ

Sub ExtractBookmarksInADoc()
'Updated by Extendoffice 20181123
    Dim xRow As Long
    Dim xTable As Table
    Dim xDoc As Document
    Dim xBookMark As Bookmark
    Dim xBookMarkDoc As Document
    Dim xParagraph As Paragraph
    Set xDoc = ActiveDocument
    If xDoc.Bookmarks.Count = 0 Then
        MsgBox "There is no bookmark in this document", vbInformation, "KuTools for Word"
        Exit Sub
    End If
    Set xBookMarkDoc = Documents.Add
    xRow = 1
    Selection.TypeText "BookMarks in " & "'" & xDoc.Name & "'"
    Set xTable = Selection.Tables.Add(Selection.Range, 1, 3)
    xTable.Borders.Enable = True
    With xTable
        .Cell(xRow, 1).Range.Text = "Name"
        .Cell(xRow, 2).Range.Text = "Texts"
        .Cell(xRow, 3).Range.Text = "Page Number"
        For Each xBookMark In xDoc.Bookmarks
            xTable.Rows.Add
            xRow = xRow + 1
            .Cell(xRow, 1).Range.Text = xBookMark.Name
            .Cell(xRow, 2).Range.Text = xBookMark.Range.Text
            .Cell(xRow, 3).Range.Text = xBookMark.Range.Information(wdActiveEndAdjustedPageNumber)
            xDoc.Hyperlinks.Add Anchor:=.Cell(xRow, 3).Range, Address:=xDoc.Name, _
              SubAddress:=xBookMark.Name, TextToDisplay:=.Cell(xRow, 3).Range.Text
        Next
    End With
    xBookMarkDoc.SaveAs xDoc.Path & "\" & "Bookmarks in " & xDoc.Name
End Sub

3. Нажмите клавишу F5, чтобы запустить код.

Затем автоматически создаётся новый документ со всеми закладками из указанного документа.

4. Вы можете нажать Файл > Печать, чтобы распечатать список извлечённых закладок по своему усмотрению.

---

Прямая печать всех закладок с помощью VBA

Если вы хотите напрямую распечатать все закладки в текущем документе, выполните следующие действия.

1. Откройте документ, закладки из которого вы хотите распечатать, и нажмите клавиши Alt+F11, чтобы открыть окно Microsoft Visual Basic for Applications.

2. В окне Microsoft Visual Basic for Applications выберите Вставка > Модуль, затем скопируйте приведённый ниже код в окно модуля.

Код VBA: печать всех закладок в документе

Sub ExtractBookmarksInADoc()
'Updated by Extendoffice 20181123
    Dim xRow As Long
    Dim xTable As Table
    Dim xDoc As Document
    Dim xBookMark As Bookmark
    Dim xBookMarkDoc As Document
    Dim xParagraph As Paragraph
    On Error Resume Next
    Set xDoc = ActiveDocument
    If xDoc.Bookmarks.Count = 0 Then
        MsgBox "There is no bookmark in this document", vbInformation, "KuTools for Word"
        Exit Sub
    End If
    Set xBookMarkDoc = Documents.Add
    xRow = 1
    Selection.TypeText "BookMarks in " & "'" & xDoc.Name & "'"
    Set xTable = Selection.Tables.Add(Selection.Range, 1, 3)
    xTable.Borders.Enable = True
    With xTable
        .Cell(xRow, 1).Range.Text = "Name"
        .Cell(xRow, 2).Range.Text = "Texts"
        .Cell(xRow, 3).Range.Text = "Page Number"
        For Each xBookMark In xDoc.Bookmarks
            xTable.Rows.Add
            xRow = xRow + 1
            .Cell(xRow, 1).Range.Text = xBookMark.Name
            .Cell(xRow, 2).Range.Text = xBookMark.Range.Text
            .Cell(xRow, 3).Range.Text = xBookMark.Range.Information(wdActiveEndAdjustedPageNumber)
            xDoc.Hyperlinks.Add Anchor:=.Cell(xRow, 3).Range, Address:=xDoc.Name, _
              SubAddress:=xBookMark.Name, TextToDisplay:=.Cell(xRow, 3).Range.Text
        Next
    End With
    xBookMarkDoc.SaveAs xDoc.Path & "\" & "Bookmarks in " & xDoc.Name
    xBookMarkDoc.PrintOut
    xBookMarkDoc.Close
    Kill xBookMarkDoc.Path
End Sub

3. Нажмите клавишу F5, чтобы напрямую распечатать закладки.