Word belgesindeki yer işareti listesini nasıl yazdırabilirim?

Daha önce bir Word belgesindeki yer işaretlerinin listesini yazdırmayı denediniz mi? İşte bunu gerçekleştirmenize yardımcı olacak yöntemler!

Tüm yer işaretlerini VBA ile çıkarın ve yazdırın

Tüm yer işaretlerini doğrudan VBA ile yazdırın

---

Tüm yer işaretlerini VBA ile çıkarın ve yazdırın

Aşağıdaki VBA kodu, Geçerli Belge’deki tüm yer işaretlerini yeni bir belgeye listeleyerek çıkarmanıza olanak tanır; böylece bu yer işaretlerini istediğiniz şekilde manuel olarak yazdırabilirsiniz. Lütfen aşağıdaki adımları izleyin.

1. Yer işaretlerini yazdırmak istediğiniz belgeyi açın ve Alt + F11 tuşlarına basarak Microsoft Visual Basic for Applications penceresini açın.

2. Microsoft Visual Basic for Applications penceresinde, Ekle > Modül seçeneğine tıklayıp aşağıdaki kodu Modül penceresine kopyalayın.

VBA kodu: Tüm yer işaretlerini yeni bir belgeye çıkar

Sub ExtractBookmarksInADoc()
'Updated by Extendoffice 20181123
    Dim xRow As Long
    Dim xTable As Table
    Dim xDoc As Document
    Dim xBookMark As Bookmark
    Dim xBookMarkDoc As Document
    Dim xParagraph As Paragraph
    Set xDoc = ActiveDocument
    If xDoc.Bookmarks.Count = 0 Then
        MsgBox "There is no bookmark in this document", vbInformation, "KuTools for Word"
        Exit Sub
    End If
    Set xBookMarkDoc = Documents.Add
    xRow = 1
    Selection.TypeText "BookMarks in " & "'" & xDoc.Name & "'"
    Set xTable = Selection.Tables.Add(Selection.Range, 1, 3)
    xTable.Borders.Enable = True
    With xTable
        .Cell(xRow, 1).Range.Text = "Name"
        .Cell(xRow, 2).Range.Text = "Texts"
        .Cell(xRow, 3).Range.Text = "Page Number"
        For Each xBookMark In xDoc.Bookmarks
            xTable.Rows.Add
            xRow = xRow + 1
            .Cell(xRow, 1).Range.Text = xBookMark.Name
            .Cell(xRow, 2).Range.Text = xBookMark.Range.Text
            .Cell(xRow, 3).Range.Text = xBookMark.Range.Information(wdActiveEndAdjustedPageNumber)
            xDoc.Hyperlinks.Add Anchor:=.Cell(xRow, 3).Range, Address:=xDoc.Name, _
              SubAddress:=xBookMark.Name, TextToDisplay:=.Cell(xRow, 3).Range.Text
        Next
    End With
    xBookMarkDoc.SaveAs xDoc.Path & "\" & "Bookmarks in " & xDoc.Name
End Sub

3. Kodu çalıştırmak için F5 tuşuna basın.

Ardından, belirtilen belgenin tüm yer işaretlerini içeren yeni bir belge otomatik olarak oluşturulur.

4. Çıkarılan yer işaretleri listesini ihtiyaç duyduğunuz şekilde yazdırmak için Dosya > Yazdır seçeneğine tıklayabilirsiniz.

---

Tüm yer işaretlerini doğrudan VBA ile yazdırın

Geçerli belgedeki tüm yer işaretlerini doğrudan yazdırmak istiyorsanız, lütfen aşağıdaki adımları izleyin.

1. Yer işaretlerini yazdırmak istediğiniz belgeyi açın ve Alt+F11tuşlarına basarak Microsoft Visual Basic for Applicationspenceresini açın.

2. Microsoft Visual Basic for Applicationspenceresinde,Ekle>Modülseçeneğine tıklayın, ardından aşağıdaki kodu Modül penceresine kopyalayın.

VBA kodu: Bir belgedeki tüm yer işaretlerini yazdır

Sub ExtractBookmarksInADoc()
'Updated by Extendoffice 20181123
    Dim xRow As Long
    Dim xTable As Table
    Dim xDoc As Document
    Dim xBookMark As Bookmark
    Dim xBookMarkDoc As Document
    Dim xParagraph As Paragraph
    On Error Resume Next
    Set xDoc = ActiveDocument
    If xDoc.Bookmarks.Count = 0 Then
        MsgBox "There is no bookmark in this document", vbInformation, "KuTools for Word"
        Exit Sub
    End If
    Set xBookMarkDoc = Documents.Add
    xRow = 1
    Selection.TypeText "BookMarks in " & "'" & xDoc.Name & "'"
    Set xTable = Selection.Tables.Add(Selection.Range, 1, 3)
    xTable.Borders.Enable = True
    With xTable
        .Cell(xRow, 1).Range.Text = "Name"
        .Cell(xRow, 2).Range.Text = "Texts"
        .Cell(xRow, 3).Range.Text = "Page Number"
        For Each xBookMark In xDoc.Bookmarks
            xTable.Rows.Add
            xRow = xRow + 1
            .Cell(xRow, 1).Range.Text = xBookMark.Name
            .Cell(xRow, 2).Range.Text = xBookMark.Range.Text
            .Cell(xRow, 3).Range.Text = xBookMark.Range.Information(wdActiveEndAdjustedPageNumber)
            xDoc.Hyperlinks.Add Anchor:=.Cell(xRow, 3).Range, Address:=xDoc.Name, _
              SubAddress:=xBookMark.Name, TextToDisplay:=.Cell(xRow, 3).Range.Text
        Next
    End With
    xBookMarkDoc.SaveAs xDoc.Path & "\" & "Bookmarks in " & xDoc.Name
    xBookMarkDoc.PrintOut
    xBookMarkDoc.Close
    Kill xBookMarkDoc.Path
End Sub

3. Yer işaretlerini doğrudan yazdırmak için F5 tuşuna basın.