1

Тема: Активация всплывающей подсказки макросом

Как известно, в "недрах" Word'а есть штатные макросы для перехода к концевым и обычным сноскам, примечаниям и гиперссылкам.
Если в тексте есть указанные штучки, то с помощью этих команд можно по ним прыгать. Правда, удобных кнопок на панели для них, можно сказать, не предусмотрено.
Кнопки, конечно, можно сделать, но удобнее назначить горячие клавиши — сочетания. Например, так как предложено ниже напротив команд. Указанные сочетания по умолчанию свободны, то есть, не заняты другими командами. Это уже будет хорошо для перехода по ним.

GoToPreviousEndnote Alt+P
GoToNextEndnote Alt+,

GoToPreviousFootnote Alt+O
GoToNextFootnote Alt+>

PreviousComment Alt+I
NextComment Alt+<

GoToPreviousHyperLink Alt+U
GoToNextHyperLink Alt+M

Но всем известно, что при наведении на сноску, ссылку или примечание появляется всплывающая подсказка. Однако, если прыгать с помощью сочетаний, то никаких подсказок не дождешься. Можно сказать, что иногда даже трудно заметить, как курсор перескакивает от сноски к сноске.
Я много раз интересовался на форумах, как активировать всплывающую подсказку без наведения на сноску указателя мыши, но что-то не очень много было полезных советов.
Тем не менее что-то удалось наспрашивать, и из моей затеи получилось то, что читатели сейчас увидят. Где я сдул фрагменты кода, и кто мне подсказывал, я теперь не могу сказать, но благодарен всем советчикам. Две вещи могу утверждать: применить таймер и мультипликацию курсора мне привиделось во сне; а как оно работает, я не знаю.
К теме прикладывается документ со сносками, ссылками и примечаниями, и по ним можно попрыгать, если предварительно назначить указанные или другие горячие клавиши для соответствующих команд. Особенность документа в том, что в нем для пояснений к таблицам применяются в основном концевые сноски, и это очень удобно (по крайней мере, мне так кажется).
И, конечно, прикладывается код макросов, в основе которых, как сказано выше — штатные команды Word.
Что касается работоспособности этого кода, то замечено: зависит всплытие подсказки и от режима (разметка, обычный, web), и от масштаба, и от размера и сложности текста, и еще от чего-то, но в большинстве случаев подсказки всплывают. Но меньшинство случаев (когда они не хотят всплывать) все же огорчает.
Поэтому, если кто-нибудь насоветует другие варианты, прошу сообщить.

Sub СноскаКонцеваяПред()
Dim cX As Long, cY As Long, i As Byte
        Application.Run "GoToPreviousEndnote"
            ActiveWindow.GetPoint cX, cY, 0&, 0&, Selection.Range
                For i = 0 To 1
                    SetCursorPos cX + i, cY + i
                    Dim Start
                    Start = Timer ' текущее время в секундах (Знать бы еще, что тут происходит. Но оно работает!)
                    Do While Timer < Start + 0.1
                    Loop
                Next i
                    SetCursorPos cX + i, cY + i
End Sub

Sub СноскаКонцеваяСлед()
Dim cX As Long, cY As Long, i As Byte
        Application.Run "GoToNextEndnote"
            ActiveWindow.GetPoint cX, cY, 0&, 0&, Selection.Range
                For i = 0 To 1
                    SetCursorPos cX + i, cY + i
                    Dim Start
                    Start = Timer ' текущее время в секундах (Знать бы еще, что тут происходит. Но оно работает!)
                    Do While Timer < Start + 0.1
                    Loop
                Next i
                    SetCursorPos cX + i, cY + i
End Sub

Sub СноскаОбычнаяПред()
Dim cX As Long, cY As Long, i As Byte
        Application.Run "GoToPreviousFootnote"
            ActiveWindow.GetPoint cX, cY, 0&, 0&, Selection.Range
' На данный момент (02.02.2020) это самый действенный цикл для более-менее надежного всплытия подсказок к ссылкам, сноскам, примечаниям и гиперссылкам.
                For i = 0 To 1
                    SetCursorPos cX + i, cY + i
                    Dim Start
                    Start = Timer ' текущее время в секундах (Знать бы еще, что тут происходит. Но оно работает!)
                    Do While Timer < Start + 0.1
                    Loop
                Next i
                    SetCursorPos cX + i, cY + i
End Sub

Sub СноскаОбычнаяСлед()
Dim cX As Long, cY As Long, i As Byte
        Application.Run "GoToNextFootnote"
            ActiveWindow.GetPoint cX, cY, 0&, 0&, Selection.Range
                For i = 0 To 1
                    SetCursorPos cX + i, cY + i
                    Dim Start
                    Start = Timer ' текущее время в секундах (Знать бы еще, что тут происходит. Но оно работает!)
                    Do While Timer < Start + 0.1
                    Loop
                Next i
                    SetCursorPos cX + i, cY + i
End Sub

Sub ПРИМПред()
Dim cX As Long, cY As Long, i As Byte
    Selection.GoTo What:=wdGoToComment, Which:=wdGoToPrevious, Count:=1
            ActiveWindow.GetPoint cX, cY, 0&, 0&, Selection.Range
                For i = 0 To 1
                    SetCursorPos cX + i, cY + i
                    Dim Start
                    Start = Timer ' текущее время в секундах (Знать бы еще, что тут происходит. Но оно работает!)
                    Do While Timer < Start + 0.1
                    Loop
                Next i
                    SetCursorPos cX + i, cY + i
End Sub

Sub ПРИМСлед()
Dim cX As Long, cY As Long, i As Byte
    Selection.GoTo What:=wdGoToComment, Which:=wdGoToNext, Count:=1
            ActiveWindow.GetPoint cX, cY, 0&, 0&, Selection.Range
                For i = 0 To 1
                    SetCursorPos cX + i, cY + i
                    Dim Start
                    Start = Timer ' текущее время в секундах (Знать бы еще, что тут происходит. Но оно работает!)
                    Do While Timer < Start + 0.1
                    Loop
                Next i
                    SetCursorPos cX + i, cY + i
End Sub

Sub ГиперСсылкаПред()
    Dim cX As Long, cY As Long, i As Byte
        Selection.GoTo What:=wdGoToField, Which:=wdGoToPrevious, Count:=1, Name:="HYPERLINK"
            ActiveWindow.GetPoint cX, cY, 0&, 0&, Selection.Range
                For i = 0 To 1
                    SetCursorPos cX + i, cY + i
                    Dim Start
                    Start = Timer ' текущее время в секундах (Знать бы еще, что тут происходит. Но оно работает!)
                    Do While Timer < Start + 0.1
                    Loop
                Next i
                    SetCursorPos cX + i, cY + i
End Sub
Sub ГиперСсылкаСлед()
    Dim cX As Long, cY As Long, i As Byte
        Selection.GoTo What:=wdGoToField, Which:=wdGoToNext, Count:=1, Name:="HYPERLINK"
            ActiveWindow.GetPoint cX, cY, 0&, 0&, Selection.Range
                For i = 0 To 1
                    SetCursorPos cX + i, cY + i
                    Dim Start
                    Start = Timer ' текущее время в секундах (Знать бы еще, что тут происходит. Но оно работает!)
                    Do While Timer < Start + 0.1
                    Loop
                Next i
                    SetCursorPos cX + i, cY + i
End Sub
Post's attachments

RC W13 RU COLOR TYPE ALL COMMANDS (forum).docx 82.86 Кб, файл не был скачан. 

You don't have the permssions to download the attachments of this post.