Как добавить закладки на основе информации из таблицы - PullRequest
Новая
       19

Как добавить закладки на основе информации из таблицы

0 голосов
/ 05 октября 2018

Я нашел макрос на одном из сайтов, где Makroa извлекает все ссылки из документа на таблицу в конце страницы, включая имя ссылки, номер страницы, номер строки, номер раздела, и я хочу бытьнаоборот, т.е. через эту таблицу я хочу добавить закладки. Через эту таблицу и добавленную в нее информацию макросы существуют в документе следующим кодом:

Sub ExtractBookmarksInSameDoc () Dim objBookmark As Bookmark Dim objTable As TableDim nRow As Integer Dim objDoc As d ocument, objNewDoc As d ocument Dim objParagraph As Paragraph
Установить objDoc = Actived * ocument

Если objDoc.Bookmarks.Count = 0 Тогда MsgBox(«В этом d закладке нет закладки.» Wink_3 Остальное 'Установить objNewDoc = d ocu ments. Добавить 

Selection.TypeText Text:="Bookmarks in " & "'" & objDoc.Name & "'"

Set objTable = Selection.Tables.Add(Range:=Selection.Range, numrows:=1, numcolumns:=5)
objTable.Borders.Enable = True
nRow = 1

For Each objParagraph In objDoc.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 = "Sections"
  .Cell(1, 3).Range.Text = "Page Number"
    .Cell(1, 4).Range.Text = "lines"
    .Cell(1, 5).Range.Text = "Colm"
  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.Information(wdActiveEndSectionNumber)
    .Cell(nRow, 3).Range.Text = objBookmark.Range.Information(wdActiveEndAdjustedPageNumber)
    .Cell(nRow, 4).Range.Text = objBookmark.Range.Information(wdFirstCharacterLineNumber) '
    '(wdVerticalPositionRelativeToPage)
    '(wdFirstCharacterLineNumber)

    .Cell(nRow, 5).Range.Text = objBookmark.Range.Information(wdVerticalPositionRelativeToPage)
    '(wdStartOfRangeColumnNumber)'(wdHorizontalPositionRelativeToTextBoundary)'(wdActiveEndAdjustedPageNumber)'(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.Путь & "" & "Закладки в" & objDoc.Name E nd Sub

...