按 'Alt' 时在用户窗体中显示所有 ControlTipText

Show all ControlTipText's in a UserForm on pressing 'Alt'

我正在尝试将 ControlTipText 添加到所有用户表单中的所有 MSForms.Control,可以显示。

添加完所有控件后,我想在按下 'Alt' 时显示所有 ControlTipText,这样我就可以轻松编辑 Excel-Sheet 上的控件提示。

采取婴儿步骤,我首先 'tried' 在向其添加值时立即使 ControlTip 可见。

我现在拥有的是:

Dim tips As Worksheet
Set tips = Worksheets("CONTROLTIPS")

Dim i As Integer
Dim ctrl As MSForms.Control

i = 0
For Each ctrl In uf.Controls        
    ctrl.ControlTipText = tips.Cells(i + 3, 2).Value        
   ' ctrl .... ("TIPTEXT").Visible = True ?!?        
    i = i + 1        
Next ctrl

I want to Show all ControlTipText's on pressing 'Alt'

据我所知,这似乎是您启动此线程的原因。

控件提示中的值存储在 .ControlTipText 函数中。据我所知,ALT 按钮不会显示所有控制提示,也没有类似的替代方法。您可以做的是在消息框中显示所有控件提示及其各自的控件:

Private Sub UserForm_Initialize
    Dim ctrl As Control
    For Each ctrl In Me.Controls
        txt = txt & ctrl.Name & ": " & ctrl.ControlTipText & vbNewLine
    Next ctrl
    MsgBox txt
End Sub

没有直接的方法来显示控件的工具提示。唯一的方法是使用 API 模拟 mouse hover。这是一个非常基本的例子。请随意修改它以满足您的需要。

准备:

  1. 创建一个空白用户表单
  2. 在用户窗体上放置一个命令按钮,并将其控制提示文本设置为您想要的任何内容。

逻辑:

当按下ALT键时,将鼠标移动到相关控件上从而触发控件提示文本

代码

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

Option Explicit

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

Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long

Private Declare Function GetDeviceCaps Lib "Gdi32" _
(ByVal hDC As Long, ByVal nIndex As Long) As Long

Private Declare Function ReleaseDC Lib "user32" _
(ByVal hwnd As Long, ByVal hDC As Long) As Long

Private Declare Function ClientToScreen Lib "user32" _
(ByVal hwnd As Long, lpPoint As POINTAPI) As Long

Private Declare Function SetCursorPos Lib "user32" _
(ByVal X As Long, ByVal Y As Long) As Long

Private Const Xindex = 88
Private Const Yindex = 90

Private Type POINTAPI
    X As Long
    Y As Long
End Type

'~~> Trap the Alt key in the keydown eveent
Private Sub CommandButton1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = 18 Then MoveMouseOnTopOf Me, CommandButton1
End Sub

'~~> Simulate mouse hover
Public Sub MoveMouseOnTopOf(frm As Object, ctl As Object)
    Dim P As POINTAPI
    Dim usrfrmHwnd As Long
    Dim hDC As Long
    Dim X As Double, Y As Double

    hDC = GetDC(0)
    X = 72 / GetDeviceCaps(hDC, Xindex)
    Y = 72 / GetDeviceCaps(hDC, Yindex)
    ReleaseDC 0, hDC

    P.X = (ctl.Left + (ctl.Width \ 2)) / X
    P.Y = (ctl.Top + (ctl.Height \ 2)) / Y

    usrfrmHwnd = FindWindow(vbNullString, frm.Caption)
    ClientToScreen usrfrmHwnd, P

    SetCursorPos P.X, P.Y
End Sub

您可以在 AllAPI 站点中阅读并了解上面使用的 API。