自訂事件 - 工作表上的Image控制項

[leonchou]

之前回答問題時有講過自訂事件(物件類別模組)，
不知誰還有印象? 來複習一下吧。

自訂事件，看來有點複雜，但可一勞永逸。
就是如果每個控制項都做同樣原則的動作，
你不用爲每個控制項都寫一遍類似的代碼。

以下範例是在一工作表中，有數十個Image控制項，
按下每個Image要執行一段變換圖片的動作，
而這些動作是有規則性的。
你要為每個Image寫一個 Click 事件嗎?
當然不用那麼麻煩，來看自訂事件的威力吧。

'Class1 (新增一個物件類別模組Class1)
Public WithEvents imageGroup As MSforms.Image '自訂Image群組物件

Private Sub imageGroup_Click() '所有Image共同的Click事件

　　Call DispCH(imageGroup)
　　
　　'Refresh image (mouse pointer no leave)
　　ActiveWindow.LargeScroll Down:=1
　　ActiveWindow.LargeScroll Up:=1

End Sub

'ThisWorkbook模組
Private Sub Workbook_Open() '把所有Image連結到自訂Image群組
　　Dim ctl As OLEObject

　　cnt = 0
　　For Each ctl In Sheet1.OLEObjects
　　　　If ctl.ProgId = "Forms.Image.1" And Not _
　　　　　 ctl.Name Like "Image5[123]" Then
　　　　　　cnt = cnt + 1
　　　　　　ReDim Preserve objClass(1 To cnt)
　　　　　　Set objClass(cnt).imageGroup = ctl.Object
　　　　End If
　　Next ctl

End Sub

'Module1 模組
Public objClass() As New Class1

Sub DispCH(obj As Image) '變換Image圖像
　　Dim no As Integer

　 no = Replace(obj.Name, "Image", "")

　 With Sheet1
　 Select Case .Cells(no, 1).Value
　　　　Case 0
　　　　　　obj.Picture = .Image52.Picture
　　　　　　.Cells(no, 1).Value = 1
　　　　Case 1
　　　　　　obj.Picture = .Image53.Picture
　　　　　　.Cells(no, 1).Value = 2
　　　　Case Else
　　　　　　obj.Picture = .Image51.Picture
　　　　　　.Cells(no, 1).Value = 0
　　End Select
　　End With
End Sub

'Sheet1 模組
Private Sub CommandButton1_Click() '重設Image圖像

　　Dim ctl As OLEObject

　　Range("A1:A700").Value = 2

　　For Each ctl In Me.OLEObjects
　　　　If ctl.ProgId = "Forms.Image.1" And Not _
　　　　　 ctl.Name Like "Image5[123]" Then

　　　　　 Call DispCH(ctl.Object)

　　　　End If
　　Next ctl

End Sub

其實看多了應該也可理解：自訂事件也是有規則性的。
能變化的就是各種不同的物件與事件，
試著自己寫寫看，概念弄清楚，
熟練之後能舉一反三，就可以運用自如了。

[附件已被管理員刪除]

[higger]

我得承認我完全看不懂~~~

大大可否先舉個簡單的例子...
像自訂"儲存格若遭CLEAR"的事件~~會導致某格的值變化..."
這種很實際的~~~

[leonchou]

大大可否先舉個簡單的例子...
像自訂"儲存格若遭CLEAR"的事件~~會導致某格的值變化..."
這種很實際的~~~

這個用內建的 Change 事件就可以搞定了，
用不著自訂事件吧?
事件/巨集/表單 - 認識與簡介

[higger]

使用名為 Worksheet_Change 的巨集, 例 --

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$A$1" Then Exit Sub '限制為A1儲存格才起作用
Application.EnableEvents = False
Target.Value = Target - [B1]
Application.EnableEvents = True
End Sub

大大...依你那個連結...我把它複製出來...
你的意思是...像change...是系統內建的"事件"...
那首先
Private Sub Worksheet_Change(ByVal Target As Range)
上這行是怎麼出來的?(是用手打出來的嗎?)
如果是在作表單時...
可以直接在...比如textbox按兩下...進入程式碼視窗後...
sub名會自動生成....Private Sub TextBox1_Change()
而且我可以從上面框框選到其它事件....像enter或keyup等

如果是像你那種事件...除了按f1...你怎麼知道有這個事件???

其二...你的意思還有...
事件只要我們想的到...都是可以自己寫出來的...是這樣吧~
那這個我倒蠻有興趣的...
再研究研究...

[oobird]

既名為 Worksheet_Change 事件必置於該sheet模組，打開該模組，編輯區上面的兩個小視窗，左邊預設是"一般"，右邊為"宣告"，按左邊的下拉軸，選worksheet,右邊的下拉軸就會有一些選擇，找到chang就行了。

[higger]

所以還有針對worksheet和workbook兩種預定事件~~~~
受教了~~~