Jak dávkově extrahovat všechny záložky z dokumentu aplikace Word

V dnešním článku bychom se s vámi rádi podělili o kroky k hromadnému extrahování všech záložek z vašeho dokumentu aplikace Word, abyste je mohli zobrazit najednou.

Ve Wordu můžete pomocí vestavěné funkce vygenerovat obsah nebo tabulku obrázků. Nakonec však zjistíte, že neexistuje žádný obvyklý způsob, jak extrahovat všechny záložky dokumentu a uspořádat je do nového dokumentu.

Jako vždy je naším posláním provést vás mýtem a poskytnout vám makro způsob, jak exportovat všechny záložky a jejich texty do nového prázdného dokumentu.

Dávkové extrahování všech záložek z jednoho dokumentu

1. Chcete-li začít, otevřete cílový dokument a stiskněte klávesy „Alt+F11“ pro spuštění editoru VBA.
2. Dále klikněte na „Normální“ a poté na „Vložit“.
3. A vyberte „Modul“ pro vytvoření nového pod projektem „Normální“.
4. Poté na něj dvakrát klikněte, abyste otevřeli prostor pro úpravy.
5. Vložte tam následující makro:

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

6. V neposlední řadě klikněte na „Spustit“.

Všechny záložky aktuálního dokumentu budou umístěny do tabulky nového dokumentu uloženého ve stejném adresáři jako původní soubor.

V novém dokumentu můžete vidět tabulku se 3 sloupci. A pokud budete následovat „Ctrl+ Click“, přenese vás to na záložku v původním dokumentu.

Dávkové extrahování záložek z více dokumentů

Při instalaci a spuštění makra postupujte podle stejných kroků výše. Pouze tentokrát nahradíte kódy níže uvedenými:

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

Jakmile makro spustíte, objeví se vstupní pole. Zadejte cestu ke složce, kam ukládáte všechny dokumenty. A pamatujte si přidejte „\“ na konec cesty pokud jej pouze zkopírujete z textového pole složky. Poté klikněte na „OK“.

Jak se rychle zachránit před datovou katastrofou

K datové katastrofě, o které mluvíme ve Wordu, může dojít, kdykoli přestane fungovat abnormálně. Někdy máte štěstí a máte všechny informace nedotčené. A jindy se stanete obětí katastrofy. Proto nejrychlejším způsobem, jak získat co nejvíce dat, je získat nástroj opravit docx.

Úvod autora:

Vera Chen je expertka na obnovu dat DataNumen, Inc., která je světovým lídrem v oblasti technologií pro obnovu dat, včetně opravit xlsx a pdf opravy softwarových produktů. Pro více informací navštivte www.datanumen.com