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: Добавление закладок на литературу и гиперссылки из текста на оную

XRumer 16.0 + XEvil 4.0: NEW revolutional software for SEO/SMM

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

1. Powerful AI: "XEvil" can bypass more than 8000 of different types of Captcha,
including so popular, like Google-captcha (ReCaptcha-1, ReCaptcha-2), Captcha.Com, SolveMedia, Bing-Captcha,
Facebook-captcha, Ucoz-captcha, DLE-captcha, VBulletin-Captcha, SMF-Captcha and a lot of other

2. High speed and precision: in speed 0.01 second per image,
XEvil can recognize and solve wide types or captcha with high precision,
without depending of difficulty, distortion, noises, fonts, colors.

3. Very simple interface: just 3 main buttons to start recognition,
it so easy to use XEvil with a wide spectre of SEO, SMM, Analytics,
Mass Registering/Postion/Sending/Bruteforcing/Bitcoin Mining Software.

4. Flexible: logic of XEvil scripted with Lua - easy language,
so if you need, you can adjust functionality as you want.

Interested? wink
just google for "XRumer + XEvil".
Free DEMO version is available!

Thank you for your attention! smile

___
See also: Elon Musk was right: artifitial intelligence will make new WAR. The "XEvil" was released!, Free XEvil Demo can solve 99% types of captcha (yii2 antigate component), BEST software for captcha breaking!
XEvil will crash worldwide internet, BEST software for captcha breaking! (captcha solving), All internet will be CRASHED with XEvil!?

7

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

8

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