Как изменить положение окна комментария при наведении курсора на него?

Question

Итак, я изменил положение поля комментария с помощью VBA, но он отображает только эту новую позицию, когда я нажимаю «редактировать/показывать комментарий». Почему он не показывает эту новую позицию, когда я нависаю над ячейкой?

Answer 1

По умолчанию вы не можете сделать показ комментариев в заранее определенном месте, когда вы наведите указатель мыши на ячейку. Сказав, что если мы создадим цикл в коде, который постоянно захватывает Mouse Co-Ordinates, тогда да, мы можем достичь того, чего хотим. Тем не менее это не идеальное решение, так как любой цикл замедляет работу вашей книги.

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

Этот код использует API GetCursorPos. Вы можете прочитать об API в ссылке, которую я упоминал, который также случается быть мой любимчик сайт для APIs :)

Скажем, Cell C4 имеет комментарий

Теперь Вставьте этот код в модуль.

Option Explicit 

Public Declare Function GetCursorPos Lib "user32" _ 
(lpPoint As POINTAPI) As Long 

Public Type POINTAPI 
    x As Long 
    y As Long 
End Type 

Dim lngCurPos As POINTAPI 
Public CancelHover As Boolean 
Dim C4_Left As Double, C4_Right As Double, C4_Top As Double, C4_Bottom As Double 

Public Sub ActivateHover() 
    CancelHover = False 

    With ActiveWindow 
     C4_Left = .PointsToScreenPixelsX(Range("C4").Left) 
     C4_Right = .PointsToScreenPixelsX(Range("C4").Offset(0, 1).Left) 
     C4_Top = .PointsToScreenPixelsY(Range("C4").Top) 
     C4_Bottom = .PointsToScreenPixelsY(Range("C4").Offset(1, 0).Top) 
    End With 

    Do 
     GetCursorPos lngCurPos 

     If lngCurPos.x > C4_Left And lngCurPos.x < C4_Right Then 
      If lngCurPos.y > C4_Top And lngCurPos.y < C4_Bottom Then 
       '~~> Show the comment forcefully 
       Range("C4").Comment.Visible = True 
       '~~> Re-position the comment. Can use other properties as .Left etc 
       Range("C4").Comment.Shape.Top = 100 
      Else 
       Range("C4").Comment.Visible = False 
      End If 
     End If 

     DoEvents 
    Loop Until CancelHover = True 
End Sub 

Добавьте кнопку на листе и в случае щелчка кнопки добавить код, который будет останавливать выше цикл.

Private Sub CommandButton1_Click() 
    CancelHover = True 
End Sub 

Теперь, когда вы наводите указатель мыши на ячейку, комментарий переместится в заданную позицию.

Примечание: Я все еще пытаюсь усовершенствовать код у него еще не очень точны. PointsToScreenPixelsX не дает мне точных размеров, очевидно, поэтому комментарий иногда показывает, даже когда я наводил на себя B3. Как я уже сказал, я пытаюсь это исправить.