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

Словесные решения 28 сентября, 2025
Поделись сейчас:

В сегодняшней статье мы хотели бы поделиться с вами шагами по пакетному извлечению всех закладок из вашего документа Word, чтобы просмотреть их сразу.

В Word вы можете создать оглавление или таблицу рисунков с помощью встроенной функции. Но в конечном итоге вы обнаружите, что нет обычного способа извлечь все закладки из документа и расположить их в новом документе.Как выполнить пакетное извлечение всех закладок из документа Word

Как всегда, наша миссия состоит в том, чтобы провести вас через миф и предоставить вам макрос для экспорта всех закладок, а также их текстов в новый пустой документ.

Пакетное извлечение всех закладок из одного документа

  1. К starвыключи, открой tarполучите документ и нажмите «Alt + F11», чтобы вызвать редактор VBA.
  2. Затем нажмите «Обычный», а затем «Вставить».
  3. И выберите «Модуль», чтобы создать новый в «Обычном» проекте.Нажмите «Обычный» -> нажмите «Вставить» -> нажмите «Модуль».
  4. Затем дважды щелкните по нему, чтобы открыть пространство редактирования.
  5. Вставьте туда следующий макрос:
Sub ExtractBookmarksInADoc()
  Dim objBookmark As Bookmark
  Dim objTable As Table
  Dim nRow As Integer
  Dim objDoc As Document, objNewDoc As Document
  Dim objParagraph As Paragraph
 
  Set objDoc = ActiveDocument
 
  If objDoc.Bookmarks.Count = 0 Then
    MsgBox ("There is no bookmark in this document.")
  Else
    Set objNewDoc = Documents.Add
 
    Selection.TypeText Text:="Bookmarks in " & "'" & objDoc.Name & "'"
 
    Set objTable = Selection.Tables.Add(Range:=Selection.Range, numrows:=1, numcolumns:=3)
    objTable.Borders.Enable = True
    nRow = 1
 
    For Each objParagraph In objNewDoc.Paragraphs
      If objParagraph.Range.Style = "Caption" Then
        objParagraph.Range.Delete
      End If
    Next objParagraph
 
    With objTable
      .Cell(1, 1).Range.Text = "Name"
      .Cell(1, 2).Range.Text = "Texts"
      .Cell(1, 3).Range.Text = "Page Number"
 
      For Each objBookmark In objDoc.Bookmarks
        objTable.Rows.Add
        nRow = nRow + 1
        .Cell(nRow, 1).Range.Text = objBookmark.Name
        .Cell(nRow, 2).Range.Text = objBookmark.Range.Text
        .Cell(nRow, 3).Range.Text = objBookmark.Range.Information(wdActiveEndAdjustedPageNumber)
        objDoc.Hyperlinks.Add Anchor:=.Cell(nRow, 3).Range, Address:=objDoc.Name, _
          SubAddress:=objBookmark.Name, TextToDisplay:=.Cell(nRow, 3).Range.Text
      Next objBookmark
    End With
  End If
  objNewDoc.SaveAs2 FileName:=objDoc.Path & "\" & "Bookmarks in " & objDoc.Name
End Sub
  1. И последнее, но не менее важное: нажмите «Выполнить».Вставьте коды-> Нажмите «Выполнить».

Все закладки текущего документа будут помещены в таблицу нового документа, сохраненного в том же каталоге, что и исходный файл.

Вы можете увидеть таблицу из 3 столбцов в новом документе. И если вы будете следовать «Ctrl+Click», это приведет вас к закладке в исходном документе.Таблица всех закладок с их текстами и номерами страниц

Пакетное извлечение закладок из нескольких документов

Выполните те же действия, что и выше, чтобы установить и запустить макрос. Только на этот раз вы заменяете коды нижеприведенными:

Sub ExtractBookmarksInMultiDoc()
  Dim objBookmark As Bookmark
  Dim objTable As Table
  Dim nRow As Integer
  Dim objDoc As Document, objNewDoc As Document
  Dim objParagraph As Paragraph
  Dim strFolder As String, strFile As String
 
  strFolder = InputBox("Enter folder path here: ")
  strFile = Dir(strFolder & "*.docx", vbNormal)
 
  While strFile <> ""
    Set objDoc = Documents.Open(FileName:=strFolder & strFile)
    Set objDoc = ActiveDocument
    Set objNewDoc = Documents.Add
 
    Selection.TypeText Text:="Bookmarks in " & "'" & objDoc.Name & "'"
 
    Set objTable = Selection.Tables.Add(Range:=Selection.Range, numrows:=1, numcolumns:=3)
    objTable.Borders.Enable = True
    nRow = 1
 
    For Each objParagraph In objNewDoc.Paragraphs
      If objParagraph.Range.Style = "Caption" Then
        objParagraph.Range.Delete
      End If
    Next objParagraph
 
    With objTable
      .Cell(1, 1).Range.Text = "Name"
      .Cell(1, 2).Range.Text = "Texts"
      .Cell(1, 3).Range.Text = "Page Number"
 
      For Each objBookmark In objDoc.Bookmarks
        objTable.Rows.Add
        nRow = nRow + 1
        .Cell(nRow, 1).Range.Text = objBookmark.Name
        .Cell(nRow, 2).Range.Text = objBookmark.Range.Text
        .Cell(nRow, 3).Range.Text = objBookmark.Range.Information(wdActiveEndAdjustedPageNumber)
        objDoc.Hyperlinks.Add Anchor:=.Cell(nRow, 3).Range, Address:=objDoc.Name, _
          SubAddress:=objBookmark.Name, TextToDisplay:=.Cell(nRow, 3).Range.Text
      Next objBookmark
    End With
    objNewDoc.SaveAs2 FileName:=objDoc.Path & "\" & "Bookmarks in " & objDoc.Name
    objDoc.Close
    strFile = Dir()
  Wend
End Sub

После запуска макроса появляется поле ввода. Введите путь к папке, в которой вы храните все документы. И не забудьте добавить «\» в конце пути если вы просто скопируете его из текстового поля папки. Затем нажмите «ОК».Введите путь к папке-> Нажмите «ОК»

Как быстро спасти себя от информационной катастрофы

Катастрофа данных, о которой мы говорим в Word, может произойти всякий раз, когда он перестает работать ненормально. Иногда вам везет, и вся информация остается нетронутой. А в других случаях вы становитесь жертвой катастрофы. Таким образом, самый быстрый способ получить как можно больше данных — это получить инструмент для исправить документ.

Об авторе:

Вера Чен — эксперт по восстановлению данных в DataNumen, Inc., которая является мировым лидером в области технологий восстановления данных, включая восстановить xlsx и pdf ремонт программных продуктов. Для получения дополнительной информации посетите www.datanumen.com

Поделись сейчас:

Комментарии закрыты.