Cùng 1 lệnh image_click cho nhiều đối tượng IMAGE trong 1 userform

[vietmai]

em chào mọi người!!
em có 1 userform(UF1) trong đó có 8 control IMAGE(từ Image1->Image8) (số lượng ảnh này không xác định tùy vào số lượng ảnh(shape...)có thể tăng lên ,đối tượng Image được thêm bằng tay không dùng code) được để dưới dang Shape(1->8) trong sheet1 ,giờ phải làm sao để khi ấn vào từng image bằng events Image_click thì hiện ra userform mới (UF2) trong đó có 1 control Image giống y đối tượng Image vừa click ạ
VD như là ấn bào Image1 thì bên UF2 sẽ hiện hình của Image1

em muốn hỏi làm các tạo events click cho tất cac đối tượng IMAGE ở UF1

 

[ndu96081631]

em chào mọi người!!
em có 1 userform(UF1) trong đó có 8 control IMAGE(từ Image1->Image8) (số lượng ảnh này không xác định tùy vào số lượng ảnh(shape...)có thể tăng lên ,đối tượng Image được thêm bằng tay không dùng code) được để dưới dang Shape(1->8) trong sheet1 ,giờ phải làm sao để khi ấn vào từng image bằng events Image_click thì hiện ra userform mới (UF2) trong đó có 1 control Image giống y đối tượng Image vừa click ạ
VD như là ấn bào Image1 thì bên UF2 sẽ hiện hình của Image1

em muốn hỏi làm các tạo events click cho tất cac đối tượng IMAGE ở UF1

Tham khảo ở đây thử:

Dùng Class Module để tạo sự kiện người dùng

Tôi đang trong những bước đầu tiên nghiên cứu về Class Module nên sẽ viết theo sự hiểu biết của tôi. Nếu có sai sót, mong các cao thủ bổ sung thêm Mục đích của bài viết này là: - Tạo sự kiện người dùng khi mà các sự kiện cung cấp sẳn không đáp ứng được nhu cầu - Khi mà chúng ta có nhu cầu "thu...

www.giaiphapexcel.com

 

[vietmai]

Tham khảo ở đây thử:

Dùng Class Module để tạo sự kiện người dùng

Tôi đang trong những bước đầu tiên nghiên cứu về Class Module nên sẽ viết theo sự hiểu biết của tôi. Nếu có sai sót, mong các cao thủ bổ sung thêm Mục đích của bài viết này là: - Tạo sự kiện người dùng khi mà các sự kiện cung cấp sẳn không đáp ứng được nhu cầu - Khi mà chúng ta có nhu cầu "thu...

www.giaiphapexcel.com

cảm ơn anh đã chỉ !! em có thử làm theo nhưng mà event click ko hoạt động, anh có thể giúp em xem vì sao dc không ạ
có lẽ em chưa hiểu rõ bản chất nên anh có thể chỉ em với giải thích đoạn anh sửa giúp em dc hok anh

 

[HeSanbi]

Sử dụng CallByName thì Class Module chỉ cần viết một lần duy nhất cho tất cả mọi sự kiện
Code như bên dưới

Code Userform:

Option Explicit
Private ObjectImages As Collection

Private Sub UserForm_Initialize()
  Dim I As Integer
  Dim sh As String
  Dim Shape As String
  Dim target As Control
  Dim Image As mutilImg
 
  sh = "Sheet1"
  For I = 1 To 8
      Shape = "Shape" & I
      UploadImage Me.Controls.Item("Image" & I), sh, Shape
      Set Image = New mutilImg
      Image.Init Me.Controls.Item("Image" & I), I, "CallbackByEvent"
  Next I
End Sub
Sub CallbackByEvent(Control As Object, index%, EventControl As String, _
            Optional ByVal b%, _
            Optional ByVal s%, _
            Optional ByVal X!, _
            Optional ByVal Y!)
  On Error Resume Next
  Select Case EventControl
  Case "MouseDown"
    Dim F
    For Each F In VBA.UserForms
      If F.Name = "UF2" Then  Unload F: Exit For
    Next
    Debug.Print index
    Unload Me
  End Select
End Sub

-------------------------------------



Class Module sự kiện:

Option Explicit

Private WithEvents ImageCL As MSForms.Image
Private im, form, P$, I

Sub Init(Image As Object, index, callback$)
  Set ImageCL = Image
  Set im = Image
  Set form = FormParent(Image)
  P = callback
  I = index
End Sub

Private Sub CB(ByVal E$, Optional ByVal b%, Optional ByVal s%, Optional ByVal X!, Optional ByVal Y!)
  On Error Resume Next
  VBA.CallByName form, P, 1, im, I, E, b, s, X, Y
End Sub

Private Sub ImageCL_MouseDown(ByVal b%, ByVal s%, ByVal X!, ByVal Y!): CB "MouseDown", b, s, X, Y: End Sub

Private Sub Class_Initialize()
  Set im = Nothing
  Set form = Nothing
  Set ImageCL = Nothing
End Sub

Private Function FormParent(ByVal Child As Object) As Object
  On Error GoTo E
  Dim k&
  Set FormParent = Child
  Do
    Set FormParent = FormParent.Parent:
    k = k + 1: If k > 150 Then Exit Do
  Loop
E: On Error GoTo 0
End Function

 

[ndu96081631]

cảm ơn anh đã chỉ !! em có thử làm theo nhưng mà event click ko hoạt động, anh có thể giúp em xem vì sao dc không ạ
có lẽ em chưa hiểu rõ bản chất nên anh có thể chỉ em với giải thích đoạn anh sửa giúp em dc hok anh

Bạn chưa làm được là bởi: hình trên sheet là Picture, trong khi hình mà ta cần load lên Image phải là IPictureDisp <--- 2 thể loại khác nhau.
Vậy bạn cần phải thêm công đoạn biến object thành IPictureDisp, xong mới load lên image
Code trong Class sửa thành:

Public WithEvents ImageCL As MSForms.Image
Private Sub ImageCL_Click()
  Dim thutu As String
  Dim IPicDisp As IPictureDisp
  thutu = Right(ImageCL.Name, 1)
  UF1.Hide
  Set IPicDisp = modIPicDisp.PictureFromObject(Sheet1.Pictures("Shape" & thutu), False)
  UF2.Image1.Picture = IPicDisp
  UF2.Show
End Sub

Cái modIPicDisp.PictureFromObject chính là hàm PictureFromObject nằm trong module modIPicDisp (xem trong file)
Code trong UF1:

Dim img() As New mutilImg
Private Sub UserForm_Initialize()
  Dim i As Integer
  Dim ctrl As Control
  For Each ctrl In Me.Controls
    If TypeOf ctrl Is MSForms.Image Then
      i = i + 1
      ReDim Preserve img(1 To i)
      Set img(i).ImageCL = ctrl
     End If
  Next
End Sub

 

[vietmai]

Sử dụng CallByName thì Class Module chỉ cần viết một lần duy nhất cho tất cả mọi sự kiện
Code như bên dưới

Code Userform:

Option Explicit
Private ObjectImages As Collection

Private Sub UserForm_Initialize()
  Dim I As Integer
  Dim sh As String
  Dim Shape As String
  Dim target As Control
  Dim Image As mutilImg

  sh = "Sheet1"
  For I = 1 To 8
      Shape = "Shape" & I
      UploadImage Me.Controls.Item("Image" & I), sh, Shape
      Set Image = New mutilImg
      Image.Init Me.Controls.Item("Image" & I), I, "CallbackByEvent"
  Next I
End Sub
Sub CallbackByEvent(Control As Object, index%, EventControl As String, _
            Optional ByVal b%, _
            Optional ByVal s%, _
            Optional ByVal X!, _
            Optional ByVal Y!)
  On Error Resume Next
  Select Case EventControl
  Case "MouseDown"
    Dim F
    For Each F In VBA.UserForms
      If F.Name = "UF2" Then  Unload F: Exit For
    Next
    Debug.Print index
    Unload Me
  End Select
End Sub

-------------------------------------



Class Module sự kiện:

Option Explicit

Private WithEvents ImageCL As MSForms.Image
Private im, form, P$, I

Sub Init(Image As Object, index, callback$)
  Set ImageCL = Image
  Set im = Image
  Set form = FormParent(Image)
  P = callback
  I = index
End Sub

Private Sub CB(ByVal E$, Optional ByVal b%, Optional ByVal s%, Optional ByVal X!, Optional ByVal Y!)
  On Error Resume Next
  VBA.CallByName form, P, 1, im, I, E, b, s, X, Y
End Sub

Private Sub ImageCL_MouseDown(ByVal b%, ByVal s%, ByVal X!, ByVal Y!): CB "MouseDown", b, s, X, Y: End Sub

Private Sub Class_Initialize()
  Set im = Nothing
  Set form = Nothing
  Set ImageCL = Nothing
End Sub

Private Function FormParent(ByVal Child As Object) As Object
  On Error GoTo E
  Dim k&
  Set FormParent = Child
  Do
    Set FormParent = FormParent.Parent:
    k = k + 1: If k > 150 Then Exit Do
  Loop
E: On Error GoTo 0
End Function

em cam on anh

Bạn chưa làm được là bởi: hình trên sheet là Picture, trong khi hình mà ta cần load lên Image phải là IPictureDisp <--- 2 thể loại khác nhau.
Vậy bạn cần phải thêm công đoạn biến object thành IPictureDisp, xong mới load lên image
Code trong Class sửa thành:

Public WithEvents ImageCL As MSForms.Image
Private Sub ImageCL_Click()
  Dim thutu As String
  Dim IPicDisp As IPictureDisp
  thutu = Right(ImageCL.Name, 1)
  UF1.Hide
  Set IPicDisp = modIPicDisp.PictureFromObject(Sheet1.Pictures("Shape" & thutu), False)
  UF2.Image1.Picture = IPicDisp
  UF2.Show
End Sub

Cái modIPicDisp.PictureFromObject chính là hàm PictureFromObject nằm trong module modIPicDisp (xem trong file)
Code trong UF1:

Dim img() As New mutilImg
Private Sub UserForm_Initialize()
  Dim i As Integer
  Dim ctrl As Control
  For Each ctrl In Me.Controls
    If TypeOf ctrl Is MSForms.Image Then
      i = i + 1
      ReDim Preserve img(1 To i)
      Set img(i).ImageCL = ctrl
     End If
  Next
End Sub

em cảm ơn anh vì đã giúp đỡ ạ!!