如何在悬停在其上时更改评论框的位置？

Question

好的，所以我使用VBA更改了评论框的位置，但是当我点击“编辑/显示评论”时它只显示这个新位置。当我将鼠标悬停在单元格上时，为什么不显示这个新位置？

Answer 1

默认情况下，当您将鼠标悬停在单元格上时，无法在预定义的位置显示评论。话虽如此，如果我们在代码中创建一个循环，不断捕获Mouse Co-Ordinates，那么是的，有可能实现我们想要的。这仍然不是一个理想的解决方案，因为任何循环都会降低工作簿的速度。

我发布此解决方案只是为了证明它是可能的。

此代码使用GetCursorPos API。您可以在我提到的链接中阅读有关API的信息，这也恰好是我最喜欢的API网站：）

让我们说，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说谎时，评论有时也会显示。就像我说的那样，我正在努力完善它。