vba 悬停在评论框上时如何更改评论框的位置？
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/21465538/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
How to change the position of a comment box when hovered over it?
提问by SCar88
Ok, so I have changed the position of a comment box using VBA, but it only shows this new position when I click "edit/show comment". Why does it not show this new position when I hover over the cell?
好的，所以我使用 VBA 更改了评论框的位置，但是当我单击“编辑/显示评论”时它只显示这个新位置。为什么当我将鼠标悬停在单元格上时它不显示这个新位置？
回答by Siddharth Rout
By default, you cannot make the comment show at a pre-defined location when you hover on a cell. Having said that if we sort of create a loop in the code which constantly captures the Mouse Co-Ordinates then yes it is possible to achieve what we want. Still this is not an ideal solution as any loop slows down your workbook.
默认情况下，当您将鼠标悬停在单元格上时，您无法在预定义位置显示评论。话虽如此，如果我们在代码中创建一个循环来不断捕获鼠标坐标，那么是的，就有可能实现我们想要的。这仍然不是一个理想的解决方案，因为任何循环都会减慢您的工作簿的速度。
I am posting this solution to only demonstrate that it is possible.
我发布此解决方案只是为了证明这是可能的。
This code uses the GetCursorPosAPI. You may read about the API in the link that I mentioned which also happens to be my fav site for APIs :)
此代码使用GetCursorPosAPI。您可以在我提到的链接中阅读有关 API 的信息，这也是我最喜欢的 API 站点：)
Let's say, Cell C4 has a comment
比方说，Cell C4 有一条评论
Now Paste this code in a module.
现在将此代码粘贴到模块中。
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
Add a button on the worksheet and in the click event of the button add this code which will stop the above loop.
在工作表上添加一个按钮，并在按钮的单击事件中添加此代码，这将停止上述循环。
Private Sub CommandButton1_Click()
CancelHover = True
End Sub
Now when you hover the mouse over the cell, the comment will move to the pre-defined position.
现在，当您将鼠标悬停在单元格上时，注释将移动到预定义的位置。
Note: I am still trying to perfect the code at it is still not very accurate. The PointsToScreenPixelsXis not giving me accurate dimensions obviously so the comment sometimes shows even when I hover on say B3. Like I said, I am trying to perfect that.
注意：我仍在尝试完善代码，但仍然不是很准确。在PointsToScreenPixelsX没有给我准确的尺寸显然这样的评论有时会出现，甚至当我悬停上的发言权B3。就像我说的，我正在努力完善它。
