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

1 Тема от nikgreek 12.04.2018 12:02:10

nikgreek
рядовой
Неактивен

Зарегистрирован: 05.04.2018
Сообщений: 3

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

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

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

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 Ответ от Fck_This 12.04.2018 12:55:40

Fck_This
генерал-полковник
Неактивен

Откуда: Минск, Беларусь
Зарегистрирован: 13.07.2016
Сообщений: 648
Поблагодарили: 97

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

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

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

3 Ответ от Fck_This 12.04.2018 13:05:48

Fck_This
генерал-полковник
Неактивен

Откуда: Минск, Беларусь
Зарегистрирован: 13.07.2016
Сообщений: 648
Поблагодарили: 97
За сообщение: 1

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 Ответ от nikgreek 12.04.2018 16:01:35

nikgreek
рядовой
Неактивен

Зарегистрирован: 05.04.2018
Сообщений: 3

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 Ответ от Fck_This 12.04.2018 16:50:50

Fck_This
генерал-полковник
Неактивен

Откуда: Минск, Беларусь
Зарегистрирован: 13.07.2016
Сообщений: 648
Поблагодарили: 97

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

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

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

6 Ответ от nikgreek 13.04.2018 09:43:45

nikgreek
рядовой
Неактивен

Зарегистрирован: 05.04.2018
Сообщений: 3

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 Ответ от Fck_This 13.04.2018 10:01:59

Fck_This
генерал-полковник
Неактивен

Откуда: Минск, Беларусь
Зарегистрирован: 13.07.2016
Сообщений: 648
Поблагодарили: 97
За сообщение: 1

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

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

Сообщений [ 7 ]

1 Тема от nikgreek 12.04.2018 12:02:10

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

2 Ответ от Fck_This 12.04.2018 12:55:40

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

3 Ответ от Fck_This 12.04.2018 13:05:48

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

4 Ответ от nikgreek 12.04.2018 16:01:35

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

5 Ответ от Fck_This 12.04.2018 16:50:50

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

6 Ответ от nikgreek 13.04.2018 09:43:45

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

7 Ответ от Fck_This 13.04.2018 10:01:59

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

Сообщений [ 7 ]

Похожие темы

страницы

авторство

рубрики