[已解决]如何将窗体内的标签进行颜色设置

c888

标识提醒设置（窗体）.rar (21.5 KB, 下载次数: 11)

2013-1-18 20:32 上传

点击文件名下载附件
谢谢！

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2013-1-18 21:12

1. Sub SetColor(ByVal controlname As String)
   
2.     Dim top&, left&
   
3.     Dim ct
   
4.     top = Me.Controls(controlname).top
   
5.     left = Me.Controls(controlname).left
   
6.     For Each ct In Me.Controls
   
7.         If ct.top = top Or ct.left = left Then
   
8.             ct.BackColor = &HFF&
   
9.         Else
   
10.             ct.BackColor = &H8000000F
    
11.         End If
    
12.     Next
    
13. End Sub
    
14. 
    
15. Private Sub Label19_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    
16.     Call SetColor("label19")
    
17. End Sub

复制代码

如果能够取鼠标在窗体中的位置，就更好办了。

跳转到最佳答案楼层

hwc2ycy

1. Sub SetColor(ByVal controlname As String)
   
2.     Dim top&, left&
   
3.     Dim ct
   
4.     top = Me.Controls(controlname).top
   
5.     left = Me.Controls(controlname).left
   
6.     For Each ct In Me.Controls
   
7.         If ct.top = top Or ct.left = left Then
   
8.             ct.BackColor = &HFF&
   
9.         Else
   
10.             ct.BackColor = &H8000000F
    
11.         End If
    
12.     Next
    
13. End Sub
    
14. 
    
15. Private Sub Label19_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    
16.     Call SetColor("label19")
    
17. End Sub

复制代码

如果能够取鼠标在窗体中的位置，就更好办了。

hwc2ycy

选中所有的标签，设置ENABLE为FALSE，就可以了。

1. Private Sub UserForm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
   
2.     Dim ct
   
3.     For Each ct In Me.Controls
   
4.         With ct
   
5.         If .left <= X And .left + .Width >= X And .top <= Y And .top + .Height >= Y Then
   
6.             SetColor (ct.Name)
   
7.             Exit For
   
8.         End If
   
9.         End With
   
10.     Next
    
11. End Sub

复制代码

hwc2ycy

再改下，颜色没有重置。

1. Private Sub UserForm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
   
2.     Dim ct
   
3.     For Each ct In Me.Controls
   
4.         With ct
   
5.         If .left <= X And .left + .Width >= X And .top <= Y And .top + .Height >= Y Then
   
6.             SetColor (ct.Name)
   
7.             Exit Sub
   
8.         End If
   
9.         End With
   
10.     Next
    
11.     For Each ct In Me.Controls
    
12.         ct.BackColor = &H8000000F
    
13.     Next
    
14. End Sub

复制代码

hwc2ycy

添加鼠标左键要求
Button值，可以反应出是鼠标按了哪个键。
fmButtonLeft 1 按下左键。
fmButtonRight 2 按下右键。
fmButtonMiddle 4 按下中键。

1. Private Sub UserForm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
   
2.     Dim ct
   
3.     If Button = 1 Then
   
4.         For Each ct In Me.Controls
   
5.             With ct
   
6.                 If .left <= X And .left + .Width >= X And .top <= Y And .top + .Height >= Y Then
   
7.                     SetColor (ct.Name)
   
8.                     Exit Sub
   
9.                 End If
   
10.             End With
    
11.         Next
    
12.         For Each ct In Me.Controls
    
13.             ct.BackColor = &H8000000F
    
14.         Next
    
15.     End If
    
16. End Sub

复制代码

c888

hwc2ycy 发表于 2013-1-18 21:12
如果能够取鼠标在窗体中的位置，就更好办了。

谢谢，可以了。谢谢！

hwc2ycy

LABEL没法给焦点，这个就不好办。

c888

hwc2ycy 发表于 2013-1-18 21:30
LABEL没法给焦点，这个就不好办。

用这样可以，只是代码多，能否简化一下。谢谢！

Sub SetColor(ByVal controlname As String)
    Dim top&, left&
    Dim ct
    top = Me.Controls(controlname).top
    left = Me.Controls(controlname).left
    For Each ct In Me.Controls
        If ct.top = top Or ct.left = left Then
            ct.BackColor = &HC0C0FF
        Else
            ct.BackColor = &H8000000F
        End If
    Next
End Sub
Private Sub Label1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Call SetColor("label1")
End Sub
Private Sub Label2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Call SetColor("label2")
End Sub
Private Sub Label3_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Call SetColor("label3")
End Sub
Private Sub Label4_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Call SetColor("label4")
End Sub
Private Sub Label5_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Call SetColor("label5")
End Sub
Private Sub Label6_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Call SetColor("label6")
End Sub
Private Sub Label7_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Call SetColor("label7")
End Sub
Private Sub Label8_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Call SetColor("label8")
End Sub
Private Sub Label9_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Call SetColor("label9")
End Sub
Private Sub Label10_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Call SetColor("label10")
End Sub
Private Sub Label11_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Call SetColor("label11")
End Sub
Private Sub Label12_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Call SetColor("label12")
End Sub
Private Sub Label13_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Call SetColor("label13")
End Sub
Private Sub Label14_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Call SetColor("label14")
End Sub
Private Sub Label15_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Call SetColor("label15")
End Sub
Private Sub Label16_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Call SetColor("label16")
End Sub
Private Sub Label17_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Call SetColor("label17")
End Sub
Private Sub Label18_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Call SetColor("label18")
End Sub
Private Sub Label19_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Call SetColor("label19")
End Sub
Private Sub Label20_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Call SetColor("label20")
End Sub
Private Sub Label21_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Call SetColor("label21")
End Sub
Private Sub Label22_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Call SetColor("label22")
End Sub
Private Sub Label23_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Call SetColor("label23")
End Sub
Private Sub Label24_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Call SetColor("label24")
End Sub
Private Sub Label25_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Call SetColor("label25")
End Sub
Private Sub Label26_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Call SetColor("label26")
End Sub
Private Sub Label27_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Call SetColor("label27")
End Sub
Private Sub Label28_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Call SetColor("label28")
End Sub
Private Sub Label29_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Call SetColor("label29")
End Sub
Private Sub Label30_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Call SetColor("label30")
End Sub

爱疯

标识提醒设置（窗体）3.rar (19.76 KB, 下载次数: 13)

2013-1-18 22:23 上传

点击文件名下载附件
一方面，觉得可以用；另一方面，觉得写的别扭，是找原来例子，生拼硬凑起来的。

我觉得，lab类的作用只是定义出事件(lab.dj)。而在发生该事件时，是否可用lab对象表达？希望高手纠正错误

hwc2ycy

c888 发表于 2013-1-18 22:15
用这样可以，只是代码多，能否简化一下。谢谢！

Sub SetColor(ByVal controlname As String)

你还真有耐心用第一种方法，我是怕了这样写。
所以才下窗体的MOUSEDOWN事件来实现。