2

语境：

我在 Excel 2007 中创建了几个组，每个组都包含一个文本框和图像，并且每个都分配给一个宏。

我想要的是在组的鼠标悬停/悬停时，它会显示一个“工具提示”，其中包含有关分配的宏的作用的更详细信息。我在这里遇到了看起来像解决方案的东西：http ://www.vbaexpress.com/forum/showthread.php?t=15084但是，我不知道如何找出图像的分配名称所以我可以在代码中使用该名称，但我不确定如何将其合并为使用 Group 对象，或者是否可以使用组。

问题：

根据标题，如何为分配给宏的组（文本框 + 图像）显示工具提示/信息提示？

编辑：我附上了链接中的代码副本，这样人们就不必跳页了：

通用公共模块中的代码：

Option Explicit 

Declare Function GetSystemMetrics Lib "user32" ( _ 
ByVal nIndex As Long) As Long 

Declare Function GetSysColor Lib "user32" ( _ 
ByVal nIndex As Long) As Long 


Public Function CreateToolTipLabel(objHostOLE As Object, _ 
    sTTLText As String) As Boolean 
    Dim objToolTipLbl As OLEObject 
    Dim objOLE As OLEObject 

    Const SM_CXSCREEN = 0 
    Const COLOR_INFOTEXT = 23 
    Const COLOR_INFOBK = 24 
    Const COLOR_WINDOWFRAME = 6 

    Application.ScreenUpdating = False 'just while label is created and formatted

    For Each objOLE In ActiveSheet.OLEObjects 
        If objOLE.Name = "TTL" Then objOLE.Delete 'only one can exist at a time
    Next objOLE 

     'create a label control...
    Set objToolTipLbl = ActiveSheet.OLEObjects.Add(ClassType:="Forms.Label.1") 

     '...and format it to look as a ToolTipWindow
    With objToolTipLbl 
        .Top = objHostOLE.Top + objHostOLE.Height - 10 
        .Left = objHostOLE.Left + objHostOLE.Width - 10 
        .Object.Caption = sTTLText 
        .Object.Font.Size = 8 
        .Object.BackColor = GetSysColor(COLOR_INFOBK) 
        .Object.BackStyle = 1 
        .Object.BorderColor = GetSysColor(COLOR_WINDOWFRAME) 
        .Object.BorderStyle = 1 
        .Object.ForeColor = GetSysColor(COLOR_INFOTEXT) 
        .Object.TextAlign = 1 
        .Object.AutoSize = False 
        .Width = GetSystemMetrics(SM_CXSCREEN) 
        .Object.AutoSize = True 
        .Width = .Width + 2 
        .Height = .Height + 2 
        .Name = "TTL" 
    End With 
    DoEvents 
    Application.ScreenUpdating = True 

     'delete the tooltip window after 5 secs
    Application.OnTime Now() + TimeValue("00:00:05"), "DeleteToolTipLabels" 

End Function 

Public Sub DeleteToolTipLabels() 
    Dim objToolTipLbl As OLEObject 
    For Each objToolTipLbl In ActiveSheet.OLEObjects 
        If objToolTipLbl.Name = "TTL" Then objToolTipLbl.Delete 
    Next objToolTipLbl 
End Sub

工作表中的代码（右键单击工作表选项卡>代码）

Private Sub Image1_MouseMove(ByVal Button As Integer, _ 
    ByVal Shift As Integer, _ 
    ByVal X As Single, _ 
    ByVal Y As Single) 
    Dim objTTL As OLEObject 
    Dim fTTL As Boolean 

    For Each objTTL In ActiveSheet.OLEObjects 
        fTTL = objTTL.Name = "TTL" 
    Next objTTL 

    If Not fTTL Then 
        CreateToolTipLabel Image1, "ToolTip Label" 
    End If 

End Sub
4

0 回答 0