前往小程序,Get更优阅读体验!
立即前往
首页
学习
活动
专区
工具
TVP
发布
社区首页 >专栏 >代码分享:高亮显示鼠标移动到的用户窗体上的控件

代码分享:高亮显示鼠标移动到的用户窗体上的控件

作者头像
fanjy
发布2022-06-04 09:33:47
1.1K0
发布2022-06-04 09:33:47
举报
文章被收录于专栏:完美Excel完美Excel

这是在vbaexpress.com上找到的一段代码,非常有意思,当鼠标移动到用户窗体中的控件上时,该控件会高亮显示。这可以让我们将用户窗体界面设计得更好。

示例效果如下图1所示。

图1

代码如下:

代码语言:javascript
复制
'声明默认的颜色
Const D_Lbl_Def_Bac As Long = 10066329
Const D_Lbl_Def_Bor As Long = 5066061
Const D_Lbl_Def_FoCol As Long = 16579836
 
'声明鼠标移动到标签上时显示的颜色
Const D_Lbl_Move_Bac As Long = 13750737
Const D_Lbl_Move_Bor As Long = vbWhite
Const D_Lbl_Move_FoCol As Long = 6184542
 
'用于标记标签颜色是否更改的每个标签的布尔值
Dim D_Bo_Lbl_1 As Boolean  ' "移动到这里1" 标签
Dim D_Bo_Lbl_2 As Boolean  ' "移动到这里2" 标签
Dim D_Bo_Lbl_3 As Boolean  ' "移动到这里3" 标签
Dim D_Bo_Lbl_4 As Boolean  ' "移动到这里4" 标签
 
'标签 1 的位置
Const D_L1_Top_Mi As Single = 30
Const D_L1_Top_Ma As Single = 48
Const D_L1_Left_Mi As Single = 12
Const D_L1_Left_Ma As Single = 102
 
'标签 2 的位置层级
Const D_L2_Top_Mi As Single = 30
Const D_L2_Top_Ma As Single = 48
Const D_L2_Left_Mi As Single = 126
Const D_L2_Left_Ma As Single = 216
 
'标签 3 的位置层级
Const D_L3_Top_Mi As Single = 72
Const D_L3_Top_Ma As Single = 90
Const D_L3_Left_Mi As Single = 12
Const D_L3_Left_Ma As Single = 102
 
'标签 4 的位置层级
Const D_L4_Top_Mi As Single = 72
Const D_L4_Top_Ma As Single = 90
Const D_L4_Left_Mi As Single = 126
Const D_L4_Left_Ma As Single = 216
 
Private Sub lbl_3_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X AsSingle, ByVal Y As Single)
 
    '当鼠标移动时改变颜色
    lbl_3.BackColor = D_Lbl_Move_Bac
    lbl_3.BorderColor = D_Lbl_Move_Bor
    lbl_3.ForeColor = D_Lbl_Move_FoCol
 
    D_Bo_Lbl_3 = True
 
End Sub
Private Sub lbl_4_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X AsSingle, ByVal Y As Single)
 
    '当鼠标移动时改变
    lbl_4.BackColor = D_Lbl_Move_Bac
    lbl_4.BorderColor = D_Lbl_Move_Bor
    lbl_4.ForeColor = D_Lbl_Move_FoCol
 
    D_Bo_Lbl_4 = True
End Sub
Private Sub lbl_1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X AsSingle, ByVal Y As Single)
 
    '当鼠标移动时改变颜色
    lbl_1.BackColor = D_Lbl_Move_Bac
    lbl_1.BorderColor = D_Lbl_Move_Bor
    lbl_1.ForeColor = D_Lbl_Move_FoCol
 
    D_Bo_Lbl_1 = True
End Sub
 
Private Sub lbl_2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X AsSingle, ByVal Y As Single)
 
    '当鼠标移动时改变颜色
    lbl_2.BackColor = D_Lbl_Move_Bac
    lbl_2.BorderColor = D_Lbl_Move_Bor
    lbl_2.ForeColor = D_Lbl_Move_FoCol
 
    D_Bo_Lbl_2 = True
End Sub
 
Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X AsSingle, ByVal Y As Single)
    If D_Bo_Lbl_1 = True Then  '识别 "标签1" 已经改变颜色
   
        If Y < D_L1_Top_Mi Or Y >D_L1_Top_Ma Then  '如果鼠标离开那么改变回默认颜色
            lbl_1.BackColor = D_Lbl_Def_Bac
            lbl_1.BorderColor = D_Lbl_Def_Bor
            lbl_1.ForeColor = D_Lbl_Def_FoCol
       
            D_Bo_Lbl_1 = False
            Exit Sub
        End If
   
        If X < D_L1_Left_Mi Or X >D_L1_Left_Ma Then '如果鼠标离开那么改变回默认颜色
            lbl_1.BackColor = D_Lbl_Def_Bac
            lbl_1.BorderColor = D_Lbl_Def_Bor
            lbl_1.ForeColor = D_Lbl_Def_FoCol
       
            D_Bo_Lbl_1 = False
            Exit Sub
        End If
    End If
 
    If D_Bo_Lbl_2 = True Then
   
        If Y < D_L2_Top_Mi Or Y >D_L2_Top_Ma Then
            lbl_2.BackColor = D_Lbl_Def_Bac
            lbl_2.BorderColor = D_Lbl_Def_Bor
            lbl_2.ForeColor = D_Lbl_Def_FoCol
       
            D_Bo_Lbl_2 = False
            Exit Sub
        End If
   
        If X < D_L2_Left_Mi Or X >D_L2_Left_Ma Then
            lbl_2.BackColor = D_Lbl_Def_Bac
            lbl_2.BorderColor = D_Lbl_Def_Bor
            lbl_2.ForeColor = D_Lbl_Def_FoCol
       
            D_Bo_Lbl_2 = False
            Exit Sub
        End If
    End If
 
    If D_Bo_Lbl_3 = True Then
   
        If Y < D_L3_Top_Mi Or Y >D_L3_Top_Ma Then
            lbl_3.BackColor = D_Lbl_Def_Bac
            lbl_3.BorderColor = D_Lbl_Def_Bor
            lbl_3.ForeColor = D_Lbl_Def_FoCol
       
            D_Bo_Lbl_3 = False
            Exit Sub
        End If
   
        If X < D_L3_Left_Mi Or X >D_L3_Left_Ma Then
            lbl_3.BackColor = D_Lbl_Def_Bac
            lbl_3.BorderColor = D_Lbl_Def_Bor
            lbl_3.ForeColor = D_Lbl_Def_FoCol
       
            D_Bo_Lbl_3 = False
            Exit Sub
        End If
    End If
 
    If D_Bo_Lbl_4 = True Then
   
        If Y < D_L4_Top_Mi Or Y >D_L4_Top_Ma Then
            lbl_4.BackColor = D_Lbl_Def_Bac
            lbl_4.BorderColor = D_Lbl_Def_Bor
            lbl_4.ForeColor = D_Lbl_Def_FoCol
       
            D_Bo_Lbl_3 = False
            Exit Sub
        End If
   
        If X < D_L4_Left_Mi Or X >D_L4_Left_Ma Then
            lbl_4.BackColor = D_Lbl_Def_Bac
            lbl_4.BorderColor = D_Lbl_Def_Bor
            lbl_4.ForeColor = D_Lbl_Def_FoCol
       
            D_Bo_Lbl_4 = False
            Exit Sub
        End If
    End If
End Sub
本文参与 腾讯云自媒体同步曝光计划,分享自微信公众号。
原始发表:2022-04-20,如有侵权请联系 cloudcommunity@tencent.com 删除

本文分享自 完美Excel 微信公众号,前往查看

如有侵权,请联系 cloudcommunity@tencent.com 删除。

本文参与 腾讯云自媒体同步曝光计划  ,欢迎热爱写作的你一起参与!

评论
登录后参与评论
0 条评论
热度
最新
推荐阅读
领券
问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档