Need help creating a class event

[sous2817]

Hello everyone,

Creating a class has always escaped me in VBA, but I think I'm in a spot that it can help me, so no better time to learn...Here's what I'm trying to do:

I'm working on some userforms and rather than the standard buttons, I'm using two images overlayed to create a "mouse over" effect. So every odd number image has this code:

Private Sub Image1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Image2.Visible = True
End Sub

and every even image has code like this:

Private Sub Image2_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Image2.SpecialEffect = fmSpecialEffectSunken
End Sub

Private Sub Image2_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Image2.SpecialEffect = fmSpecialEffectFlat
End Sub

Can someone point me in the direction of (or provide me with ) some class code that could save me from some redundant typing?

Thanks in advance!

 

[MickG]

Hi, What is the overall effect suppose to be.????
When I run your code I have both images visible, First code should make "Image1" visible, which it already is , what makes it not visible.
Second Code makes "Image2" sunken and not sunken, as per code
I'm not too sure what the code is actually supposed to do.!!!
I imagine you want the code to run on a number of images, By clicking any one, hence Class Module. How many images do you have ???
Regards Mick

 

[sous2817]

Hello MickG.

Sorry, I left out the middle part. Here are the steps:

Put two images on a userfrom and put image2 over image1. For image1 use this code:

Private Sub Image1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Image2.Visible = True
End Sub

The Userform needs a bit of code as well:

Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Me.Image2.Visible Then Me.Image2.Visible = False
End Sub

and:

Private Sub UserForm_Initialize()
Me.Image2.Visible = False
End Sub

This code just gives the visual que that the image has been clicked:

Private Sub Image2_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Image2.SpecialEffect = fmSpecialEffectSunken
End Sub

Private Sub Image2_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Image2.SpecialEffect = fmSpecialEffectFlat
End Sub

Since I have a lot of buttons, rather than having essentially the same code for buttons 1,3,5,7,9,11,etc (which is Image2.Visible = True,Image4.Visible = True,Image6.Visible = True, etc) I was hoping that a class module / class event would be more efficient and cut down on the total number of lines in my module.

Hope that helps clarify a bit. Let me know if you need anything else.

 

[MickG]

Hi, Please Confirm the below !!
At the Moment, when the userform shows there is one image on the Userform.
When I do a MouseOver on the image, the 2nd Image appears over the top of the First.
Then when this 2nd Image is clicked "Up"/" Down" it appears Sunken/Not Sunken.
The Object is to have lots of "Pairs" of images (Each Pair Odd & Even) on the Userform , and the same bit of code to work for each pair. "Please confirm this".
Regards Mick

 

[sous2817]

Yes that's correct.

Each odd numbered image _MouseMove event would set the .visible property for even numbered image that is one higher than it to true.

Each even numbered image_MouseDown event sets the .SpecialEffect = fmSpecialEffectSunken and the image_MouseUp event sets the .SpecialEffect = fmSpecialEffectFlat (both for that even # image).

 

[Norie]

Why use 2 images?

Couldn't the code just use LoadPicture to change what's being displayed in the control?

 

[sous2817]

I was trying to create a "mouse over" effect and that was the method that I found that worked. I'm sure there are other ways to get the same results. I'm not sure if using LoadPicture is any better because I'd still have to store all of the images on an excel sheet, wouldn't I? I don't want to have to pass all of the images along with the file, or recall the images from a networked drive.

 

[sous2817]

I think I've got it figured out (at least the mouse up and down event):

created a class module called cls_Image_Event which has the following code in it:

Option Explicit
Public WithEvents aImage As MSForms.Image
Private Sub aImage_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    aImage.SpecialEffect = fmSpecialEffectSunken
End Sub
Private Sub aImage_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    aImage.SpecialEffect = fmSpecialEffectFlat
End Sub

Then in the userform I have:

Option Explicit
Dim myImage() As cls_Image_Event
Private Sub UserForm_Initialize()
Dim ctl As Object
Dim pointer As Long
        ReDim myImage(1 To Me.Controls.Count)
            For Each ctl In Me.Controls
                If TypeName(ctl) = "Image" Then
                    pointer = pointer + 1
                    Set myImage(pointer) = New cls_Image_Event
                    Set myImage(pointer).aImage = ctl
                End If
            Next ctl

        ReDim Preserve myImage(1 To pointer)
End Sub

seems to be working as intended...

 

[sous2817]

Hm...can't seem to get code to work for every other item in the class collection. Any ideas?

 

[MickG]

Hi, I seem to have seen that bit of code before!!
This worked for me
This is the Userform Code.

[COLOR=navy]Dim[/COLOR] ImRay() [COLOR=navy]As[/COLOR] cImage
Private [COLOR=navy]Sub[/COLOR] UserForm_Initialize()
[COLOR=navy]Dim[/COLOR] Ctrl [COLOR=navy]As[/COLOR] Object, p [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
ReDim ImRay(1 To Me.Controls.count)
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Ctrl [COLOR=navy]In[/COLOR] Me.Controls
   [COLOR=navy]If[/COLOR] TypeName(Ctrl) = "Image" [COLOR=navy]Then[/COLOR]
         [COLOR=navy]If[/COLOR] Right(Ctrl.Name, Len(Ctrl.Name) - 5) Mod 2 = 0 [COLOR=navy]Then[/COLOR]
            Ctrl.Visible = False
        [COLOR=navy]End[/COLOR] If
            p = p + 1
            [COLOR=navy]Set[/COLOR] ImRay(p) = New cImage
            [COLOR=navy]Set[/COLOR] ImRay(p).cM = Ctrl
            [COLOR=navy]Set[/COLOR] ImRay(p).cUfm = Me
   [COLOR=navy]End[/COLOR] If
 [COLOR=navy]Next[/COLOR] Ctrl
        ReDim Preserve ImRay(1 To p)
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]
Private [COLOR=navy]Sub[/COLOR] UserForm_MouseMove(ByVal Button [COLOR=navy]As[/COLOR] [COLOR=navy]Integer,[/COLOR] ByVal Shift [COLOR=navy]As[/COLOR] [COLOR=navy]Integer,[/COLOR] ByVal X [COLOR=navy]As[/COLOR] Single, ByVal Y [COLOR=navy]As[/COLOR] Single)
[COLOR=navy]Dim[/COLOR] Ctrl [COLOR=navy]As[/COLOR] Object
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Ctrl [COLOR=navy]In[/COLOR] Me.Controls
   [COLOR=navy]If[/COLOR] TypeName(Ctrl) = "Image" [COLOR=navy]Then[/COLOR]
     [COLOR=navy]If[/COLOR] Right(Ctrl.Name, Len(Ctrl.Name) - 5) Mod 2 = 0 [COLOR=navy]Then[/COLOR]
        Ctrl.Visible = False
     [COLOR=navy]End[/COLOR] If
 [COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR] Ctrl
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]

This is the Class module Called "cImage"

Option Explicit
Public WithEvents cM [COLOR=navy]As[/COLOR] MSForms.Image
Public cUfm [COLOR=navy]As[/COLOR] MSForms.UserForm
Private [COLOR=navy]Sub[/COLOR] cM_MouseMove(ByVal Button [COLOR=navy]As[/COLOR] [COLOR=navy]Integer,[/COLOR] ByVal Shift [COLOR=navy]As[/COLOR] [COLOR=navy]Integer,[/COLOR] ByVal X [COLOR=navy]As[/COLOR] Single, ByVal Y [COLOR=navy]As[/COLOR] Single)
    [COLOR=navy]Dim[/COLOR] nName  [COLOR=navy]As[/COLOR] [COLOR=navy]String[/COLOR]
 [COLOR=navy]If[/COLOR] Right(cM.Name, Len(cM.Name) - 5) < cUfm.Controls.count [COLOR=navy]Then[/COLOR]
    nName = "Image" & Right(cM.Name, Len(cM.Name) - 5) + 1
    cUfm.Controls(nName).Visible = True
[COLOR=navy]End[/COLOR] If
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]
Private [COLOR=navy]Sub[/COLOR] cm_MouseDown(ByVal Button [COLOR=navy]As[/COLOR] [COLOR=navy]Integer,[/COLOR] ByVal Shift [COLOR=navy]As[/COLOR] [COLOR=navy]Integer,[/COLOR] ByVal X [COLOR=navy]As[/COLOR] Single, ByVal Y [COLOR=navy]As[/COLOR] Single)
cM.SpecialEffect = fmSpecialEffectSunken
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]
Private [COLOR=navy]Sub[/COLOR] cm_MouseUp(ByVal Button [COLOR=navy]As[/COLOR] [COLOR=navy]Integer,[/COLOR] ByVal Shift [COLOR=navy]As[/COLOR] [COLOR=navy]Integer,[/COLOR] ByVal X [COLOR=navy]As[/COLOR] Single, ByVal Y [COLOR=navy]As[/COLOR] Single)
cM.SpecialEffect = fmSpecialEffectFlat
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]

Regards Mick