ExcelTip.Net留存知识帖 ---【注:附件之前被网盘供应商清空后,现已修复-现已修复-现已修复为本地下载!】
现在位置:首页 > E问E答 > Excel VBA > 如何让窗体中的标签跟随鼠标移动?

如何让窗体中的标签跟随鼠标移动?

作者:绿色风 分类: 时间:2022-08-17 浏览:100
楼主
kevinchengcw
Q: 如何让窗体中的标签跟随鼠标移动?
A: 打开一个新的excel文档,按Alt + F11进入VBA编辑器,插入窗体,并在窗体上插入一个标签,调整标签到一个合适的大小,并双击标签,在打开的编辑框内输入如下代码:
  1. Public Follow As Boolean    '定义用于判断是否跟随的公共变量
  2. Private Sub Label1_Click()   '标签1的点击事件
  3. Follow = Not Follow   '跟随状态切换
  4. If Follow = True Then   '如果跟随鼠标为真则更改为跟随时的文字和提示内容
  5.     Label1.Caption = "追"
  6.     Label1.ControlTipText = "点我就不追了"
  7. Else    '否则更改为不跟随时的文字和提示内容
  8.     Label1.Caption = "不追"
  9.     Label1.ControlTipText = "点我我还追"
  10. End If
  11. End Sub
  12. Private Sub UserForm_Initialize()  '窗体初始化代码
  13. Follow = True   '设定跟随变量为真
  14. End Sub
  15. Private Sub UserForm_Mousemove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)  '窗体的鼠标移动事件
  16. If Follow = True Then  '判断跟随变量是否为真
  17.     If X < Label1.Width / 2 Then  '判断鼠标距窗体左侧的位置是否小于标签宽度的一半(因为我们设置的跟随位置是标签的中部,所以鼠标位置小于标签宽度的一半时标签的左侧要等于窗体的左侧,不然会被窗体“吃掉”一块)
  18.         Label1.Left = 0
  19.     ElseIf X > UserForm1.Width - Label1.Width / 2 Then   '另一个情况是鼠标距窗体右侧的位置大于标签宽度的一半
  20.         Label1.Left = UserForm1.Width - Label1.Width
  21.     Else   '其他的情况
  22.         Label1.Left = X - Label1.Width / 2
  23.     End If
  24.     If Y < Label1.Height / 2 Then   '这是对高度的判断,方法同上
  25.         Label1.Top = 0
  26.     ElseIf Y > UserForm1.Height - Label1.Height / 2 Then
  27.         Label1.Top = UserForm1.Height - Label1.Height
  28.     Else
  29.         Label1.Top = Y - Label1.Height / 2
  30.     End If
  31.     'DoEvents
  32. End If
  33. End Sub


附件示例文件。
窗体学习--标签跟随鼠标(可切换).rar
2楼
wnianzhong
真是VBA高手,好好学习!

免责声明

有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素, 经与ExcelTip.Net站长Apolloh商议并征得其同意, 现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示, 供有需要的人士查询使用,也慰缅曾经的论坛时代。 所示各个帖子的原作者如对版权有异议, 可与本人沟通提出,或于本站点留言,我们会尽快处理。 在此,感谢ExcelTip.Net站长Apolloh的支持,感谢本站点所有人**绿色风(QQ:79664738)**的支持与奉献,特此鸣谢!
------本人网名**KevinChengCW(QQ:1210618015)**原ExcelTip.Net总版主之一

评论列表
sitemap