Tüm Yer İmlerini Word Belgenizden Toplu Olarak Çıkarma

Bugünün makalesinde, Word belgenizdeki tüm yer imlerini bir kerede görüntülemek üzere toplu olarak çıkarmanın adımlarını sizinle paylaşmak istiyoruz.

Word'de, yerleşik işlevle bir içindekiler tablosu veya bir şekiller tablosu oluşturabilirsiniz. Ancak, sonunda bir belgenin tüm yer imlerini çıkarmanın ve bunları yeni bir belgede düzenlemenin olağan bir yolu olmadığını göreceksiniz.

Her zaman olduğu gibi, görevimiz size efsanede yol göstermek ve tüm yer imlerini ve bunların metinlerini yeni bir boş belgeye aktarmanın makro yolunu sağlamaktır.

Tüm Yer İmlerini Tek Bir Belgeden Toplu Olarak Ayıkla

1. Başlamak için, hedef belgeyi açın ve VBA düzenleyicisini açmak için "Alt + F11" tuşlarına basın.
2. Sonra “Normal” ve ardından “Ekle” ye tıklayın.
3. Ve "Normal" proje altında yeni bir tane oluşturmak için "Modül"ü seçin.
4. Ardından, düzenleme alanını ortaya çıkarmak için üzerine çift tıklayın.
5. Aşağıdaki makroyu oraya yapıştırın:

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. Son fakat en az değil, "Çalıştır" ı tıklayın.

Geçerli belgenin tüm yer imleri, orijinal dosyayla aynı dizine kaydedilen yeni bir belgedeki bir tabloya konulacaktır.

Yeni belgede 3 sütunlu tabloyu görebilirsiniz. Ve "Ctrl + Tıkla" yı izlerseniz, sizi orijinal belgedeki yer imine götürür.

Yer İşaretlerini Birden Çok Belgeden Toplu Çıkarın

Bir makro yüklemek ve çalıştırmak için yukarıdaki aynı adımları izleyin. Ancak bu sefer kodları aşağıdakilerle değiştiriyorsunuz:

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

Makroyu çalıştırdığınızda, bir giriş kutusu vardır. Tüm belgeleri sakladığınız klasör yolunu girin. Ve unutma yolun sonuna “\” ekleyin sadece klasör metin kutusundan kopyalarsanız. Ardından "Tamam"a tıklayın.

Kendinizi Veri Felaketinden Nasıl Hızlı Bir Şekilde Kurtarırsınız?

Word'de bahsettiğimiz veri felaketi, anormal bir şekilde çalışmayı durdurduğunda meydana gelebilir. Bazen şanslısın ve tüm bilgilere sahipsin. Ve diğer zamanlarda, felaketin kurbanı olursunuz. Bu nedenle, mümkün olduğu kadar çok veriyi almanın en hızlı yolu, bir araç edinmektir. docx'i düzelt.

Yazar Tanıtımı:

Vera Chen bir veri kurtarma uzmanıdır. DataNumendahil olmak üzere veri kurtarma teknolojilerinde dünya lideri olan , Inc. onarım xlsx hem de pdf onarım yazılım ürünleri. Daha fazla bilgi için ziyaret edin www.datanumen.com