Kako grupno izdvojiti sve knjižne oznake iz vašeg Word dokumenta

U današnjem članku željeli bismo s vama podijeliti korake za skupno izdvajanje svih knjižnih oznaka iz vašeg Word dokumenta kako biste ih vidjeli odjednom.

U Wordu možete generirati tablicu sadržaja ili tablicu slika s ugrađenom funkcijom. No, na kraju ćete otkriti da ne postoji uobičajeni način za ekstrahiranje svih knjižnih oznaka dokumenta i njihovo slaganje u novi dokument.

Kao i uvijek, naša je misija provesti vas kroz mit i pružiti vam makronačin za izvoz svih oznaka kao i njihovih tekstova u novi prazan dokument.

Skupno izdvajanje svih knjižnih oznaka iz jednog dokumenta

1. Za početak, otvorite ciljni dokument i pritisnite "Alt + F11" za pozivanje VBA editora.
2. Zatim kliknite "Normalno", a zatim "Umetni".
3. I odaberite "Modul" za stvaranje novog pod "Normalnim" projektom.
4. Zatim dvaput kliknite na nju da biste otvorili prostor za uređivanje.
5. Tamo zalijepite sljedeću makronaredbu:

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. Posljednje, ali ne i najmanje važno, kliknite "Pokreni".

Sve knjižne oznake trenutnog dokumenta bit će stavljene u tablicu na novom dokumentu spremljenom u istom direktoriju kao izvorna datoteka.

U novom dokumentu možete vidjeti tablicu od 3 stupca. A ako slijedite "Ctrl+klik", to će vas dovesti do knjižne oznake u izvornom dokumentu.

Skupno izdvajanje knjižnih oznaka iz više dokumenata

Slijedite iste gornje korake za instaliranje i pokretanje makronaredbe. Samo ovaj put zamijenite kodove sljedećim:

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

Nakon što pokrenete makro, pojavit će se okvir za unos. Unesite put do mape u koju pohranjujete sve dokumente. I ne zaboravite dodajte “\” na kraju staze ako ga samo kopirate iz tekstualnog okvira mape. Zatim kliknite "OK".

Kako se brzo spasiti od podatkovne katastrofe

Podatkovna katastrofa o kojoj govorimo u Wordu može se dogoditi kad god prestane nenormalno raditi. Ponekad vam se posreći i sve informacije ostanu netaknute. A drugi puta postanete žrtva katastrofe. Stoga je najbrži način da dohvatite što više podataka nabaviti alat za popraviti docx.

Uvod za autora:

Vera Chen stručnjakinja je za oporavak podataka u DataNumen, Inc., koji je svjetski lider u tehnologijama za oporavak podataka, uključujući popravak xlsx i pdf popraviti softverske proizvode. Za više informacija posjetite www.datanumen.com