Kaip paketu ištraukti visas žymes iš savo „Word“ dokumento

Šiandienos straipsnyje norėtume pasidalinti su jumis veiksmais, kaip iš „Word“ dokumento ištraukti visas žymes, kad galėtumėte jas peržiūrėti iš karto.

Programoje „Word“ galite sugeneruoti turinį arba paveikslų lentelę naudodami įtaisytąją funkciją. Tačiau galiausiai pastebėsite, kad nėra įprasto būdo ištraukti visas dokumento žymes ir išdėstyti jas naujame dokumente.

Kaip visada, mūsų misija yra pervesti jus per mitą ir suteikti jums makrokomandą, kaip eksportuoti visas žymes ir jų tekstus į naują tuščią dokumentą.

Pakeiskite visas žymes iš vieno dokumento

1. Norėdami pradėti, atidarykite tikslinį dokumentą ir paspauskite „Alt + F11“, kad iškviestumėte VBA redaktorių.
2. Tada spustelėkite „Įprastas“, tada „Įterpti“.
3. Ir pasirinkite „Modulis“, kad sukurtumėte naują projekte „Įprastas“.
4. Tada dukart spustelėkite jį, kad atsirastų redagavimo erdvė.
5. Įklijuokite ten šią makrokomandą:

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. Paskutinis, bet ne mažiau svarbus dalykas, spustelėkite „Vykdyti“.

Visos dabartinio dokumento žymės bus įtrauktos į lentelę naujame dokumente, įrašytame tame pačiame kataloge kaip ir pradinis failas.

Naujame dokumente galite pamatyti 3 stulpelių lentelę. Ir jei atliksite „Ctrl + Spustelėkite“, jis nukreips jus į žymę pradiniame dokumente.

Paketas ištraukite žymes iš kelių dokumentų

Atlikite tuos pačius aukščiau nurodytus veiksmus, kad įdiegtumėte ir paleistumėte makrokomandą. Tik šį kartą kodus pakeisite žemiau esančiais:

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

Kai paleisite makrokomandą, yra įvesties laukelis. Įveskite aplanko kelią, kuriame saugote visus dokumentus. Ir nepamirškite kelio pabaigoje pridėkite „\“. jei tiesiog nukopijuosite jį iš aplanko teksto laukelio. Tada spustelėkite „Gerai“.

Kaip greitai išsigelbėti nuo duomenų nelaimės

Duomenų nelaimė, apie kurią kalbame „Word“, gali įvykti, kai ji nustoja veikti neįprastai. Kartais jums pasiseka ir visa informacija yra nepažeista. O kartais tampate nelaimės auka. Todėl greičiausias būdas gauti kuo daugiau duomenų yra gauti įrankį pataisyti docx.

Autoriaus įvadas:

Vera Chen yra duomenų atkūrimo ekspertė DataNumen, Inc., kuri yra pasaulyje duomenų atkūrimo technologijų lyderė, įskaitant remontas xlsx bei pdf programinės įrangos gaminių taisymas. Norėdami gauti daugiau informacijos, apsilankykite WWW.datanumen.com