Kuinka erittää kaikki kirjanmerkit Word-dokumentista

Tämänpäiväisessä artikkelissa haluamme jakaa kanssasi vaiheet kaikkien kirjanmerkkien purkamiseen eristä Word-asiakirjasta, jotta niitä voidaan tarkastella kerralla.

Wordissa voit luoda sisällysluettelon tai kuvataulukon sisäänrakennetulla toiminnolla. Mutta viime kädessä huomaat, ettei ole tavallista tapaa purkaa asiakirjan kaikkia kirjanmerkkejä ja järjestää ne uuteen asiakirjaan.

Kuten aina, tehtävämme on johtaa sinut myytin läpi ja tarjota sinulle makrotapa viedä kaikki kirjanmerkit ja niiden tekstit uuteen tyhjään asiakirjaan.

Eräpura kaikki kirjanmerkit yhdestä asiakirjasta

1. Aloita avaamalla kohdeasiakirja ja painamalla "Alt + F11" avataksesi VBA-editorin.
2. Napsauta sitten “Normal” ja sitten “Insert”.
3. Ja valitse "Moduuli", jos haluat luoda uuden "Normaali" -projektissa.
4. Kaksoisnapsauta sitä tuodaksesi muokkaustila esiin.
5. Liitä seuraava makro sinne:

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. Viimeisenä mutta ei vähäisimpänä, napsauta "Suorita".

Kaikki nykyisen asiakirjan kirjanmerkit sijoitetaan uuden asiakirjan taulukkoon, joka on tallennettu samaan hakemistoon kuin alkuperäinen tiedosto.

Näet uuden sarakkeen 3 sarakkeen taulukon. Ja jos seuraat "Ctrl + Click", se vie sinut alkuperäisen asiakirjan kirjanmerkkiin.

Eräpura kirjanmerkit useista asiakirjoista

Noudata samoja ohjeita asentaaksesi ja suorittaaksesi makron. Vain tällä kertaa korvataan koodit röyhkeillä:

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

Kun olet suorittanut makron, siellä on syöttöruutu. Kirjoita kansion polku, johon tallennat kaikki asiakirjat. Ja muista lisää "\" polun loppuun jos kopioit sen vain kansion tekstiruudusta. Napsauta sitten “OK”.

Kuinka pelastaa itsesi nopeasti tietokatastrofista

Datakatastrofi, josta puhumme Wordissa, voi tapahtua aina, kun se lakkaa toimimasta epänormaalisti. Joskus sinulla on onnekas ja kaikki tiedot ovat ehjät. Ja muina aikoina joutut katastrofin uhriksi. Siksi nopein tapa hakea mahdollisimman paljon tietoja on hankkia työkalu korjaa docx.

Tekijän esittely:

Vera Chen on tietojen palauttamisen asiantuntija DataNumen, Inc., joka on maailman johtava tietojen palautustekniikoissa, mukaan lukien korjaa xlsx ja pdf korjata ohjelmistotuotteita. Lisätietoja osoitteessa www.datanumen.com