1

Тема: Добавление закладок на литературу и гиперссылки из текста на оную

День добрый.
Нужна помощь.
Есть текст 300 листов.
Есть список литературы. Строки помечены 1. ,2. ,3. ...
В тексте указаны ссылки на литературу в формате [1], [2], [3] ...

Закладки я реализовал, как мог smile

Sub MACROS_LIT_Add_Bookmarks()
If Selection.Words.Count <= 1 Then Exit Sub
With Selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Forward = True
        .Format = False
        .MatchCase = False
        .MatchWholeWord = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .Wrap = wdFindContinue

.Text = "1. "
.Execute
If .Found = True Then
ActiveDocument.Bookmarks.Add Name:="LIT_01"
 End If
.Text = "2. "
.Execute
If .Found = True Then
ActiveDocument.Bookmarks.Add Name:="LIT_02"
End If
.Text = "3. "
.Execute
If .Found = True Then
ActiveDocument.Bookmarks.Add Name:="LIT_03"
End If
.Text = "4. "
.Execute
If .Found = True Then
ActiveDocument.Bookmarks.Add Name:="LIT_04"
End If
.Text = "5. "
.Execute
If .Found = True Then
ActiveDocument.Bookmarks.Add Name:="LIT_05"
End If
.Text = "6. "
.Execute
If .Found = True Then
ActiveDocument.Bookmarks.Add Name:="LIT_06"
End If
.Text = "7. "
.Execute
If .Found = True Then
ActiveDocument.Bookmarks.Add Name:="LIT_07"
End If
.Text = "8. "
.Execute
If .Found = True Then
ActiveDocument.Bookmarks.Add Name:="LIT_08"
End If
.Text = "9. "
.Execute
If .Found = True Then
ActiveDocument.Bookmarks.Add Name:="LIT_09"
End If
.Text = "10. "
.Execute
If .Found = True Then
ActiveDocument.Bookmarks.Add Name:="LIT_10"
End If
.Text = "11. "
.Execute
If .Found = True Then
ActiveDocument.Bookmarks.Add Name:="LIT_11"
End If
.Text = "12. "
.Execute
If .Found = True Then
ActiveDocument.Bookmarks.Add Name:="LIT_12"
End If
.Text = "13. "
.Execute
If .Found = True Then
ActiveDocument.Bookmarks.Add Name:="LIT_13"
End If
.Text = "14. "
.Execute
If .Found = True Then
ActiveDocument.Bookmarks.Add Name:="LIT_14"
End If
.Text = "15. "
.Execute
If .Found = True Then
ActiveDocument.Bookmarks.Add Name:="LIT_15"
End If
.Text = "16. "
.Execute
If .Found = True Then
ActiveDocument.Bookmarks.Add Name:="LIT_16"
End If
.Text = "17. "
.Execute
If .Found = True Then
ActiveDocument.Bookmarks.Add Name:="LIT_17"
End If
.Text = "18. "
.Execute
If .Found = True Then
ActiveDocument.Bookmarks.Add Name:="LIT_18"
End If
.Text = "19. "
.Execute
If .Found = True Then
ActiveDocument.Bookmarks.Add Name:="LIT_19"
End If
.Text = "20. "
.Execute
If .Found = True Then
ActiveDocument.Bookmarks.Add Name:="LIT_20"
End If
.Text = "21. "
.Execute
If .Found = True Then
ActiveDocument.Bookmarks.Add Name:="LIT_21"
End If
.Text = "22. "
.Execute
If .Found = True Then
ActiveDocument.Bookmarks.Add Name:="LIT_22"
End If
.Text = "23. "
.Execute
If .Found = True Then
ActiveDocument.Bookmarks.Add Name:="LIT_23"
End If
.Text = "24. "
.Execute
If .Found = True Then
ActiveDocument.Bookmarks.Add Name:="LIT_24"
End If
.Text = "25. "
.Execute
If .Found = True Then
ActiveDocument.Bookmarks.Add Name:="LIT_25"
End If
.Text = "26. "
.Execute
If .Found = True Then
ActiveDocument.Bookmarks.Add Name:="LIT_26"
End If
.Text = "27. "
.Execute
If .Found = True Then
ActiveDocument.Bookmarks.Add Name:="LIT_27"
End If
.Text = "28. "
.Execute
If .Found = True Then
ActiveDocument.Bookmarks.Add Name:="LIT_28"
End If
.Text = "29. "
.Execute
If .Found = True Then
ActiveDocument.Bookmarks.Add Name:="LIT_29"
End If
.Text = "30. "
.Execute
If .Found = True Then
ActiveDocument.Bookmarks.Add Name:="LIT_30"
End If
.Text = "31. "
.Execute
If .Found = True Then
ActiveDocument.Bookmarks.Add Name:="LIT_31"
End If
.Text = "32. "
.Execute
If .Found = True Then
ActiveDocument.Bookmarks.Add Name:="LIT_32"
End If
.Text = "33. "
.Execute
If .Found = True Then
ActiveDocument.Bookmarks.Add Name:="LIT_33"
End If
.Text = "34. "
.Execute
If .Found = True Then
ActiveDocument.Bookmarks.Add Name:="LIT_34"
End If
.Text = "35. "
.Execute
If .Found = True Then
ActiveDocument.Bookmarks.Add Name:="LIT_35"
End If
.Text = "36. "
.Execute
If .Found = True Then
ActiveDocument.Bookmarks.Add Name:="LIT_36"
End If
.Text = "37. "
.Execute
If .Found = True Then
ActiveDocument.Bookmarks.Add Name:="LIT_37"
End If
.Text = "38. "
.Execute
If .Found = True Then
ActiveDocument.Bookmarks.Add Name:="LIT_38"
End If
.Text = "39. "
.Execute
If .Found = True Then
ActiveDocument.Bookmarks.Add Name:="LIT_39"
End If
.Text = "40. "
.Execute
If .Found = True Then
ActiveDocument.Bookmarks.Add Name:="LIT_40"
End If
End With
End Sub

Вроде работают.

А вот гиперссылки на закладки никак не могу расставить, макрос пропускает значения для поиска.
А еще ссылок на одну и туже литературу может быть больше одной.
Это тоже нужно предусмотреть.


Sub Find_Text_And_hiperlink_to_Bookmark()

With Selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Forward = True
        .Format = False
        .MatchCase = False
        .MatchWholeWord = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .Wrap = wdFindContinue

.Text = "[1]"
.Execute
If .Found = True Then
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", _
        SubAddress:="LIT_01", ScreenTip:="", TextToDisplay:="[1]"
End If
.Text = "[2]"
.Execute
If .Found = True Then
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", _
        SubAddress:="LIT_02", ScreenTip:="", TextToDisplay:="[2]"
End If
.Text = "[3]"
.Execute
If .Found = True Then
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", _
        SubAddress:="LIT_03", ScreenTip:="", TextToDisplay:="[3]"
End If

.Text = "[4]"
.Execute
If .Found = True Then
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", _
        SubAddress:="LIT_04", ScreenTip:="", TextToDisplay:="[4]"
End If
.Text = "[5]"
.Execute
If .Found = True Then
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", _
        SubAddress:="LIT_05", ScreenTip:="", TextToDisplay:="[5]"
End If
.Text = "[6]"
.Execute
If .Found = True Then
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", _
        SubAddress:="LIT_06", ScreenTip:="", TextToDisplay:="[6]"
End If
.Text = "[7]"
.Execute
If .Found = True Then
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", _
        SubAddress:="LIT_07", ScreenTip:="", TextToDisplay:="[7]"
End If
.Text = "[8]"
.Execute
If .Found = True Then
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", _
        SubAddress:="LIT_08", ScreenTip:="", TextToDisplay:="[8]"
End If
.Text = "[9]"
.Execute
If .Found = True Then
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", _
        SubAddress:="LIT_09", ScreenTip:="", TextToDisplay:="[9]"
End If
.Text = "[10]"
.Execute
If .Found = True Then
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", _
        SubAddress:="LIT_10", ScreenTip:="", TextToDisplay:="[10]"
End If
.Text = "[11]"
.Execute
If .Found = True Then
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", _
        SubAddress:="LIT_11", ScreenTip:="", TextToDisplay:="[11]"
End If
.Text = "[12]"
.Execute
If .Found = True Then
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", _
        SubAddress:="LIT_12", ScreenTip:="", TextToDisplay:="[12]"
End If
.Text = "[13]"
.Execute
If .Found = True Then
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", _
        SubAddress:="LIT_13", ScreenTip:="", TextToDisplay:="[13]"
End If
.Text = "[14]"
.Execute
If .Found = True Then
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", _
        SubAddress:="LIT_14", ScreenTip:="", TextToDisplay:="[14]"
End If
.Text = "[15]"
.Execute
If .Found = True Then
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", _
        SubAddress:="LIT_15", ScreenTip:="", TextToDisplay:="[15]"
End If
.Text = "[16]"
.Execute
If .Found = True Then
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", _
        SubAddress:="LIT_16", ScreenTip:="", TextToDisplay:="[16]"
End If
.Text = "[17]"
.Execute
If .Found = True Then
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", _
        SubAddress:="LIT_17", ScreenTip:="", TextToDisplay:="[17]"
End If
.Text = "[18]"
.Execute
If .Found = True Then
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", _
        SubAddress:="LIT_18", ScreenTip:="", TextToDisplay:="[18]"
End If
.Text = "[19]"
.Execute
If .Found = True Then
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", _
        SubAddress:="LIT_19", ScreenTip:="", TextToDisplay:="[19]"
End If
.Text = "[20]"
.Execute
If .Found = True Then
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", _
        SubAddress:="LIT_20", ScreenTip:="", TextToDisplay:="[20]"
End If
.Text = "[21]"
.Execute
If .Found = True Then
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", _
        SubAddress:="LIT_21", ScreenTip:="", TextToDisplay:="[21]"
End If
.Text = "[22]"
.Execute
If .Found = True Then
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", _
        SubAddress:="LIT_22", ScreenTip:="", TextToDisplay:="[22]"
End If
.Text = "[23]"
.Execute
If .Found = True Then
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", _
        SubAddress:="LIT_23", ScreenTip:="", TextToDisplay:="[23]"
End If
.Text = "[24]"
.Execute
If .Found = True Then
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", _
        SubAddress:="LIT_24", ScreenTip:="", TextToDisplay:="[24]"
End If
.Text = "[25]"
.Execute
If .Found = True Then
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", _
        SubAddress:="LIT_25", ScreenTip:="", TextToDisplay:="[25]"
End If
.Text = "[26]"
.Execute
If .Found = True Then
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", _
        SubAddress:="LIT_26", ScreenTip:="", TextToDisplay:="[26]"
End If
.Text = "[27]"
.Execute
If .Found = True Then
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", _
        SubAddress:="LIT_27", ScreenTip:="", TextToDisplay:="[27]"
End If
.Text = "[28]"
.Execute
If .Found = True Then
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", _
        SubAddress:="LIT_28", ScreenTip:="", TextToDisplay:="[28]"
End If
.Text = "[29]"
.Execute
If .Found = True Then
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", _
        SubAddress:="LIT_29", ScreenTip:="", TextToDisplay:="[29]"
End If
.Text = "[30]"
.Execute
If .Found = True Then
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", _
        SubAddress:="LIT_30", ScreenTip:="", TextToDisplay:="[30]"
End If
.Text = "[31]"
.Execute
If .Found = True Then
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", _
        SubAddress:="LIT_31", ScreenTip:="", TextToDisplay:="[31]"
End If
.Text = "[32]"
.Execute
If .Found = True Then
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", _
        SubAddress:="LIT_32", ScreenTip:="", TextToDisplay:="[32]"
End If
.Text = "[33]"
.Execute
If .Found = True Then
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", _
        SubAddress:="LIT_33", ScreenTip:="", TextToDisplay:="[33]"
End If
.Text = "[34]"
.Execute
If .Found = True Then
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", _
        SubAddress:="LIT_34", ScreenTip:="", TextToDisplay:="[34]"
End If
.Text = "[35]"
.Execute
If .Found = True Then
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", _
        SubAddress:="LIT_35", ScreenTip:="", TextToDisplay:="[35]"
End If
.Text = "[36]"
.Execute
If .Found = True Then
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", _
        SubAddress:="LIT_36", ScreenTip:="", TextToDisplay:="[36]"
End If
.Text = "[37]"
.Execute
If .Found = True Then
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", _
        SubAddress:="LIT_37", ScreenTip:="", TextToDisplay:="[37]"
End If
.Text = "[38]"
.Execute
If .Found = True Then
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", _
        SubAddress:="LIT_38", ScreenTip:="", TextToDisplay:="[38]"
End If
.Text = "[39]"
.Execute
If .Found = True Then
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", _
        SubAddress:="LIT_39", ScreenTip:="", TextToDisplay:="[39]"
End If
.Text = "[40]"
.Execute
If .Found = True Then
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", _
        SubAddress:="LIT_40", ScreenTip:="", TextToDisplay:="[40]"
End If
End With
End Sub

Помогите решить задачку, ну очень нужно, глаза уже болят текст искать в ручную, размечать его закладками и гиперссылками. А макросами можно сказать впервые занялся.

2

Re: Добавление закладок на литературу и гиперссылки из текста на оную

Сбросьте свой документ. Хотя бы листов 10 с расставленными ссылками, чтобы не выдумывать самому.

Спасибо можно перевести на WebMoney-кошелёк R378231864568 или на Яндекс-деньги 410015093172871

3

Re: Добавление закладок на литературу и гиперссылки из текста на оную

А лучше весь. То, что вы делаете повторно вводя поиск текста проще реализовать через цикл (где N - число ссылок), а всё, что False можно и не указывать - по умолчанию False

For i = 1 To N
sText = i & ". "
With Selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Forward = True
        .Text = sText
        .Wrap = wdFindStop
        .MatchWholeWord = True
        If .Execute = True Then
                If i < 10 Then
                        sLinkName = "LIT_0" & i
                Else
                        sLinkName = "LIT_" & i
                End If
                ActiveDocument.Bookmarks.Add Name:="LIT_01"
        End If
End With
Next n
Спасибо можно перевести на WebMoney-кошелёк R378231864568 или на Яндекс-деньги 410015093172871

4

Re: Добавление закладок на литературу и гиперссылки из текста на оную

Идеально, огромное спасибо.

Вот что получилось.

Sub MACROS_LIT_Add_Bookmarks()

For i = 1 To 40
sText = i & ". "
With Selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Forward = True
        .Text = sText
        .Wrap = wdFindContinue
        .MatchWholeWord = True
        If .Execute = True Then
                If i < 10 Then
                        sLinkName = "LIT_0" & i
                Else
                        sLinkName = "LIT_" & i
                End If
                ActiveDocument.Bookmarks.Add Name:=sLinkName
        End If
End With
Next i
End Sub

Sub MACROS_Hyperlinks_to_lit_Bookmarks()

For i = 1 To 40
sText = "[" & i & "]"
With Selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Forward = True
        .Text = sText
        .Wrap = wdFindContinue
        .MatchWholeWord = True
        If .Execute = True Then
                If i < 10 Then
                        sLinkName = "LIT_0" & i
                Else
                        sLinkName = "LIT_" & i
                End If
        ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", _
        SubAddress:=sLinkName, ScreenTip:=sLinkName
        End If
End With
Next i
End Sub

Одно но если гиперссылка в документе уже была, то новая ссылка ведет в начало текста.
Поэтому возникает еще один вопрос, как по той же схеме найти [1] [2] [3] и если в них есть гиперссылки то удалить, а если нет то перейти к поиску следующей "i".

5

Re: Добавление закладок на литературу и гиперссылки из текста на оную

Либо добавить после нахождения текста ссылки условие на проверку ссылка ли это, либо удалять просто все ссылки другим макросом перед запуском данного макроса

Спасибо можно перевести на WebMoney-кошелёк R378231864568 или на Яндекс-деньги 410015093172871

6

Re: Добавление закладок на литературу и гиперссылки из текста на оную

С очисткой разобрался - выделением текста и "Ctrl+Shift+F9"

Будьте так добры, подскажите как сделать?
Макрос находит только одно вхождение и бежит искать следующий номер.
А нужно чтобы он нашел все вхождения, сделал ссылки, а уже потом шел дальше искать следующий номер.
А еще он как-то странно ищет - находит не первое вхождение в текст, а например 3-е из 5-ти. От чего он так делает? Продолжает искать с места на котором остановился в прошлый раз?
Тестовый файл прикладываю к сообщению.

Sub MACROS_Hyperlinks_to_lit_Bookmarks()

For i = 1 To 40
sText = "[" & i & "]"
With Selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Forward = True
        .Text = sText
        .Wrap = wdFindContinue
        .MatchWholeWord = True
        If .Execute = True Then
                If i < 10 Then
                        sLinkName = "LIT_0" & i
                Else
                        sLinkName = "LIT_" & i
                End If
        ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", _
        SubAddress:=sLinkName, ScreenTip:=sLinkName
        End If
End With
Next i
End Sub

7

Re: Добавление закладок на литературу и гиперссылки из текста на оную

Не вижу файла. Но если надо находить все вхождения и искать сначала, то делаем так:

Sub MACROS_Hyperlinks_to_lit_Bookmarks()

For i = 1 To 40
Selection.HomeKey Unit:=wdStory
sText = "[" & i & "]"
With Selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Forward = True
        .Text = sText
        .Wrap = wdFindContinue
        .MatchWholeWord = True
        Do while .Execute = True
                If i < 10 Then
                        sLinkName = "LIT_0" & i
                Else
                        sLinkName = "LIT_" & i
                End If
        ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", _
        SubAddress:=sLinkName, ScreenTip:=sLinkName
        Loop
End With
Next i
Спасибо можно перевести на WebMoney-кошелёк R378231864568 или на Яндекс-деньги 410015093172871