auto-teacher
Новый пользователь
- Сообщения
- 25
- Реакции
- 4
Переход к следующей сноске (в Word 2016).
ALT+SHIFT+>
Переход к предыдущей сноске (в Word 2016).
ALT+SHIFT+<
ALT + Ctrl + стрелка влево на цифровой клавиатуре
ALT + Ctrl + стрелка вправо на цифровой клавиатуре
Option Explicit
Private WithEvents appWord As Word.Application
Private Type RANGE_POSITION
Left As Long
Top As Long
Width As Long
Height As Long
End Type
Private Enum DIRECTION
DIR_FORWARD
DIR_BACKWARD
End Enum
Private Declare Function SetCursorPos Lib "user32.dll" (ByVal x As Long, ByVal y As Long) As Long
Dim oKey1 As KeyBinding
Dim oKey2 As KeyBinding
Private Sub appWord_WindowActivate(ByVal Doc As Word.Document, ByVal Wn As Word.Window)
Call BindKey
End Sub
Private Sub Document_Close()
On Error Resume Next
oKey1.Clear
oKey2.Clear
End Sub
Private Sub Document_Open()
Set appWord = Word.Application
Call BindKey
End Sub
Private Sub BindKey()
With Application
.CustomizationContext = ThisDocument
Set oKey2 = .KeyBindings.Add( _
KeyCode:=BuildKeyCode(wdKeyAlt, wdKeyControl, wdKeyNumeric4), _
KeyCategory:=wdKeyCategoryCommand, _
Command:="GotoNoteBack")
Set oKey2 = .KeyBindings.Add( _
KeyCode:=BuildKeyCode(wdKeyAlt, wdKeyControl, wdKeyNumeric6), _
KeyCategory:=wdKeyCategoryCommand, _
Command:="GotoNoteNext")
End With
End Sub
Public Sub GotoNoteNext()
FindNote DIR_FORWARD
End Sub
Public Sub GotoNoteBack()
FindNote DIR_BACKWARD
End Sub
Private Sub FindNote(dir As DIRECTION)
Dim i As Long
If ActiveDocument.Footnotes.Count = 0 And ActiveDocument.Endnotes.Count = 0 Then
MsgBox "В документе нет сносок.", vbInformation
Exit Sub
End If
If ActiveDocument.Footnotes.Count > 0 Then
If dir = DIR_FORWARD Then
For i = 1 To ActiveDocument.Footnotes.Count
If CheckNote(ActiveDocument.Footnotes(i).Reference, dir) Then Exit Sub
Next
Else
For i = ActiveDocument.Footnotes.Count To 1 Step -1
If CheckNote(ActiveDocument.Footnotes(i).Reference, dir) Then Exit Sub
Next
End If
If MsgBox("Поиск завершен. Начать заново?", vbYesNo) = vbYes Then
Selection.Start = IIf(dir = DIR_FORWARD, 0, ActiveDocument.Content.End)
FindNote dir
End If
End If
If ActiveDocument.Endnotes.Count > 0 Then
If dir = DIR_FORWARD Then
For i = 1 To ActiveDocument.Endnotes.Count
If CheckNote(ActiveDocument.Endnotes(i).Reference, dir) Then Exit Sub
Next
Else
For i = ActiveDocument.Endnotes.Count To 1 Step -1
If CheckNote(ActiveDocument.Endnotes(i).Reference, dir) Then Exit Sub
Next
End If
If MsgBox("Поиск завершен. Начать заново?", vbYesNo) = vbYes Then
Selection.Start = IIf(dir = DIR_FORWARD, 0, ActiveDocument.Content.End)
FindNote dir
End If
End If
End Sub
Private Function CheckNote(RA As Range, dir As DIRECTION) As Boolean
Dim RP As RANGE_POSITION
If IIf(dir = DIR_FORWARD, RA.Start > Selection.Start, RA.Start < Selection.Start) Then
Selection.Start = RA.Start
Selection.End = RA.Start
Selection.Range.Select
Call ActiveWindow.GetPoint(RP.Left, RP.Top, RP.Width, RP.Height, RA)
SetCursorPos RP.Left, RP.Top
CheckNote = True
End If
End Function
я не понял как следует смысл всех операторов в коде по части GetPoint и SetCursorPos
То о чём вы просите (повесить на уже существующую горячую клавишу другое действие) - и есть самое настоящее переопределение. То есть вы вместо одной стандартной функции Word, хотите другую. Такого понятия - как дополнить одну функцию другой - нет, так как горячая клавиша вызывает только что-то одно. Если мы вмешиваемся в этот процесс, то обязаны сами исправить все, что сломали -) - в вашем случае - это команда Application.Run "GoToNextFootnote". В моём - поиск вручную.Мне не надо переопределять в макросе горячие клавиши.
GetPoint - получает координату, высоту и ширину символа - цифры сноски.я не понял как следует смысл всех операторов в коде по части GetPoint и SetCursorPos
Option Explicit
Private Type RANGE_POSITION
Left As Long
Top As Long
Width As Long
Height As Long
End Type
Private Declare Function SetCursorPos Lib "user32.dll" (ByVal x As Long, ByVal y As Long) As Long
Sub СноскаСлед()
Dim RP As RANGE_POSITION
Dim cX As Long, cY As Long
Application.Run "GoToNextFootnote"
ActiveWindow.GetPoint RP.Left, RP.Top, RP.Width, RP.Height, Selection.Next(wdCharacter)
cX = RP.Left + RP.Width \ 2
cY = RP.Top + RP.Height \ 2
SetCursorPos cX, cY
SetCursorPos cX + 1, cY + 1
SetCursorPos cX, cY
End Sub
В коде выше указатель устанавливается в координаты cX, cY, затем смещается на 1 пиксель вправо вниз, и возвращается обратно.которая заставит указатель мыши начать движение вниз и после того, как он пройдет 5-10 пикселей, прекратить движение?
Так в том то и дело, что я не вижу, так у меня всё нормально работает. Поставлю новый офис, помотрю, как дела обстоят в нём.Я Вам благодарен, но Вы же и сами должны видеть, что это не прокатит!
Sub СледСноска()
If Selection.Information(wdInFootnote) then
msgbox "Операторы 1"
Else ' Если курсор в основном тексте
msgbox "Операторы 2"
End If
End Sub
Sub СледСноска()
Dim cX As Long, cY As Long, i As Byte
On Error Resume Next
On Error GoTo 0
If Selection.StoryType = wdFootnotesStory Then ' Если курсор в области простых сносок, подсказки в этой области не будет, а просто будет перескок к след. сноске
Application.Run "GoToNextFootnote"
Else ' Следовательно, подразумевается, что курсор в основном тексте, - и, значит, подсказка должна всплыть
Application.Run "GoToNextFootnote"
ActiveWindow.GetPoint cX, cY, 0&, 0&, Selection.Range
For i = 0 To 2 ' Цикл для создания мультипликации указателю мыши
SetCursorPos cX + i, cY + i
Dim Start
Start = Timer ' текущее время в секундах
Do While Timer < Start + 0.05
Loop
Next i
End If
End Sub
Sub СледКонцеваяСноска()
' С условиями перехода в зависимости от области текста и сообщением о последней найденной концевой сноске
Dim cX As Long, cY As Long, i As Byte
Dim en As Endnote
Dim en_cnt As Long
Dim enr As Range
en_cnt = ActiveDocument.Endnotes.Count
On Error Resume Next
On Error GoTo 0
If Selection.StoryType = wdEndnotesStory Then ' Если курсор в области концевых сносок, после перехода подсказки не ожидается
Application.Run "GoToNextEndnote"
Else ' Подразумевается, что курсор в основном тексте, - подсказка должна всплыть, как дрессированный дельфин
If en_cnt > 0 Then
Application.Run "GoToNextEndnote"
ActiveWindow.GetPoint cX, cY, 0&, 0&, Selection.Range
For i = 0 To 2 ' Цикл для создания мультипликации указателю мыши
SetCursorPos cX + i, cY + i
Dim Start
Start = Timer ' текущее время в секундах
Do While Timer < Start + 0.05
Loop
Next i
Set enr = Selection.Range
For Each en In ActiveDocument.Endnotes
If en.Reference.Start = enr.Start Then
If en.Index = en_cnt Then
MsgBox "Хватит искать! Это последняя концевая сноска в документе!"
End If
End If
Next
End If
End If
End Sub
On Error Resume Next
On Error GoTo 0
For Each en In ActiveDocument.Endnotes
If en.Reference.Start = enr.Start Then
If en.Index = en_cnt Then
MsgBox "Хватит искать! Это последняя концевая сноска в документе!"
End If
End If
Next
'берем последнюю сноску
set en = ActiveDocument.Endnotes(ActiveDocument.Endnotes.Count)
If en.Reference.Start = enr.Start Then
MsgBox "Хватит искать! Это последняя концевая сноска в документе!"
end if
Из Справки (Событие MouseMove):
Событие MouseMove применяется к формам, элементам управления на форме и меткам.
События MouseMove создаются непрерывно при перемещении указателя мыши по объектам. Если только мышь не отслеживается другим объектом, объект распознает событие MouseMove, когда положение мыши находится в его границах.
Перемещение формы также может создавать событие MouseMove, даже если мышь находится в неподвижном состоянии. События MouseMove создаются при перемещении формы под указателем. Если макрос или процедура события перемещают форму в ответ на событие MouseMove, это событие может непрерывно вызывать события MouseMove.
We use cookies and similar technologies for the following purposes:
Do you accept cookies and these technologies?
We use cookies and similar technologies for the following purposes:
Do you accept cookies and these technologies?