標題: [發問] 請教各位先進 多個Label設定的問題 [打印本頁]

---

作者: pinklee    時間: 2013-5-24 14:11     標題: 請教各位先進 多個Label設定的問題

如圖,48個色碼 個別自放在不同Label裡,滑鼠移至Label上時,TextBox1就會變色
用 OptionButton 控制文字及底色 ,Label1 如下
Private Sub Label1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If UserForm1.OptionButton1 = True Then
   UserForm1.TextBox1.BackColor = Sheets("sheet2").Range("a" & 1).Value
Else
   UserForm1.TextBox1.ForeColor = Sheets("sheet2").Range("a" & 1).Value
End If
End Sub
請教各位先拜 如何一次設定48個Label呢, 謝謝指教

---

作者: GBKEE    時間: 2013-5-24 15:45

本帖最後由 GBKEE 於 2013-5-24 15:47 編輯

回復 1# pinklee
使用[物件類別模組]  一次設定48個Label
表單模組程式碼

1. 'TextBox1就會變色 改成為  Label控制項 命名為Label49
   
2. Option Explicit
   
3. Dim Form_Lable(1 To 48) As New Class1                 'Class1為[物件類別模組]
   
4. Private Sub CommandButton1_Click()
   
5.     Unload Me
   
6. End Sub
   
7. Private Sub UserForm_Initialize()
   
8.     Dim i
   
9.     For i = 1 To 48                                    '48個色碼 個別自放在不同 Label1->  Label48
   
10.         Set Form_Lable(i).La = Controls("Label" & i)   '指定到物件類別模組的 La變數中
    
11.     Next
    
12.     Label49.Caption = "文字及底色預覽"
    
13. End Sub

複製代碼

物件類別模組 Class1 程式碼

1. Option Explicit
   
2. Public WithEvents La As MSForms.Label
   
3. Private Sub La_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
   
4.      With UserForm1
   
5.         If .OptionButton1 Then
   
6.             .Label49.BackColor = La.BackColor
   
7.         ElseIf .OptionButton2 Then
   
8.             .Label49.ForeColor = La.BackColor
   
9.         End If
   
10.     End With
    
11. End Sub

複製代碼

[attach]15068[/attach]

---

作者: pinklee    時間: 2013-5-24 16:23

回復 2# GBKEE


   
感謝 GBKEE  已經可行

---

作者: borshun88    時間: 2013-5-26 10:46

本帖最後由 borshun88 於 2013-5-26 10:48 編輯

回復 2# GBKEE

感謝 GBKEE  大大
可以在請問一個問題？
因特殊需求使用La_Click/La_Dblclick 事件程序後仍有功能想要加上系統程式上,因此想增一個使用滑鼠右鍵來執行程式
例如 " La_RightClick() " 使用滑鼠右鍵來執行程式
但因系統預設沒有滑鼠右鍵click功能,請問是否有辦法將這個功能加上去?
感恩

---

作者: GBKEE    時間: 2013-5-26 13:58

回復 4# borshun88

1. Private Sub Label1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
   
2.    'Shift :組合鍵 SHIFT,ALT,CTRL 的數值
   
3.    'X 滑鼠X軸數值
   
4.    'Y 滑鼠Y軸數值
   
5.    Dim S As String
   
6.    Select Case Button
   
7.         Case 1
   
8.             S = "[左鍵]"
   
9.         Case 2
   
10.             S = "[右鍵]"
    
11.     End Select
    
12.     MsgBox "你按了 " & S
    
13. End Sub
    
14. 
    
15. Private Sub Label1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    
16.       Application.DisplayStatusBar = True
    
17.       Application.StatusBar = "滑鼠 X 軸數值 : " & X & vbLf & "  滑鼠 Y 軸數值 : " & Y
    
18.       '顯示在狀態列
    
19. End Sub

複製代碼

---

作者: borshun88    時間: 2013-5-27 07:17

回復 5# GBKEE
感謝! 問題解決了

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)