将鼠标悬停在单元格上时，有没有办法将带有长注释的单元格显示为工具提示？

Question

我有一个 Excel 表格，其中有一列单元格，每个单元格都包含很长的 cmets - 我不想扩大单元格的宽度，因为它会太宽，并且内容只会偶尔查看。每个单元格的内容都是动态的，是从外部数据源中提取的，因此会不时更改。

我想做的是能够将鼠标悬停在单元格上，然后将其全部内容显示为工具提示或评论，但当不悬停在其上时会消失。

（我知道我可以将它们设置为数据验证，但由于内容是动态的，这将不起作用）。

我想知道是否可以这样做？而且，我的 VBA 技能还很原始，所以如果有人能提供帮助，你能告诉我在哪里插入 VBA 代码以及如何让它“工作”！

提前感谢，如果有人能够提供帮助。 布赖恩

Answer 1

我的 VBA 技能非常原始，所以如果有人能提供帮助，你能告诉我在哪里插入 VBA 代码以及如何让它“工作”！

我通常不回答缺乏努力的问题，但这个问题远远超出了正常问题，所以我会尝试回答它。

hovering 可以在单元格上显示内容。当我说hovering 时，我的意思是hovering 而不是Selecting 一个单元格。

示例文件的链接发布在本文末尾。

1. 在您的文件中，转到 VBA 编辑器并插入一个用户表单。接下来放置一个标签控件并调整其大小以填充用户表单，如下图所示

2.将此代码粘贴到用户表单中

代码

Option Explicit

Const GWL_STYLE = -16
Const WS_CAPTION = &HC00000

Private Declare Function GetWindowLong _
Lib "user32" Alias "GetWindowLongA" ( _
ByVal hWnd As Long, ByVal nIndex As Long) As Long

Private Declare Function SetWindowLong _
Lib "user32" Alias "SetWindowLongA" ( _
ByVal hWnd As Long, ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long

Private Declare Function DrawMenuBar _
Lib "user32" (ByVal hWnd As Long) As Long

Private Declare Function FindWindowA _
Lib "user32" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long

Sub HideTitleBar(frm As Object)
    Dim lngWindow As Long
    Dim lFrmHdl As Long
    lFrmHdl = FindWindowA(vbNullString, frm.Caption)
    lngWindow = GetWindowLong(lFrmHdl, GWL_STYLE)
    lngWindow = lngWindow And (Not WS_CAPTION)
    Call SetWindowLong(lFrmHdl, GWL_STYLE, lngWindow)
    Call DrawMenuBar(lFrmHdl)
End Sub

'~~> Hide Title bar and border using API    
Private Sub UserForm_Initialize()
    HideTitleBar UserForm1
End Sub

'~~> Stop the execution of the code
Private Sub Label1_Click()
    StopLoop = True
    Unload Me
End Sub

这样做的目的是删除表单的标题栏和边框。

3.接下来插入一个模块并将这段代码粘贴到那里

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

Public Type POINTAPI
    x As Long
    y As Long
End Type

Public StopLoop As Boolean

Sub StartShowingCellContents()
    Dim lngCurPos As POINTAPI
    Dim rng As Range

    StopLoop = False

    Do
        '~~> Get the cursor position
        GetCursorPos lngCurPos

        '~~> This will give the cell address "under" the cursor
        Set rng = ActiveWindow.RangeFromPoint(lngCurPos.x, lngCurPos.y)

        If Not rng Is Nothing Then
            If Not rng.Cells.CountLarge > 1 Then
                With UserForm1
                    '~~> Display cell value in the label
                    .Label1.Caption = rng.Value
                    '~~> Show the form modeless
                    .Show vbModeless
                    DoEvents
                End With
            End If
        End If

        DoEvents

        '~~> Stop the loop (invoked by clicking on the userform's label
        If StopLoop = True Then Exit Sub
    Loop
End Sub

4. 然后你就完成了。首先，运行过程Sub StartShowingCellContents()。要停止，只需单击用户表单

5. 在行动。我用手机点击了图片，这样您就可以看到该单元格顶部的光标。

重要提示：

1. 在代码运行之前，您将无法执行任何操作，例如复制、粘贴、删除等。停止代码，做你想做的，然后再次运行代码。
2. 随意根据自己的喜好自定义代码。
3. 示例文件可以从HERE下载

Answer 2

这样的事情应该可以工作，我仍然需要解决的唯一问题是自动调整评论窗口的大小。默认的自动调整大小并不能很好地发挥作用，所以我将调整大小设为静态。这仅在您单击单元格时才有效，所以我应该指出这一点。

将此代码添加到ThisWorkbook 对象后面的代码中，这将适用于工作簿中的所有工作表。如果您只想为一张工作表添加此信息，请将其添加到感兴趣的工作表后面的 Worksheet_SelectionChange 部分。

Private LastTarget As Range

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    On Error Resume Next
    If Not LastTarget Is Nothing Then
        If Not LastTarget.Comment Is Nothing Then LastTarget.Comment.Delete
    End If

    If Not Trim$(Target.Value) = vbNullString Then
        If Target.Comment Is Nothing Then
            Target.AddComment Target.Text
            Target.Comment.Visible = True
            Target.Comment.Shape.Width = 300 'Change as needed
            Target.Comment.Shape.Height = 300 'Change as needed
            Target.Comment.Shape.Fill.Transparency = 0.6 'Make the comment a little see through
        End If
    End If

    Set LastTarget = Target
End Sub