Need help creating a class event

sous2817

sous2817

Well-known Member
Joined
Feb 22, 2008
Messages
2,276
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:

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:

Code: 
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!
 

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).
Sort by date Sort by votes
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
 
Upvote 0
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:

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:

Code: 
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:

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

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

Code: 
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.
 
Upvote 0
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
 
Upvote 0
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).
 
Upvote 0
Why use 2 images?

Couldn't the code just use LoadPicture to change what's being displayed in the control?
 
Upvote 0
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.
 
Upvote 0
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:

Code: 
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:

Code: 
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...
 
Upvote 0
Hm...can't seem to get code to work for every other item in the class collection. Any ideas?
 
Upvote 0
Hi, I seem to have seen that bit of code before!!
This worked for me
This is the Userform Code.
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"
Code: 
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
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question Question
Userform button click
Replies
1
Views
288
SQUIDD
S
M
  • Question Question
Please help me to correct Excel VBA code!
Replies
1
Views
351
Minh Tuan VN
M
A
  • Solved
Could not set the RowSource property. Invalid property value. Error 380
2
Replies
16
Views
265
RoryA
RoryA
A
  • Solved
Calendar form cancel button passing data to worksheet
Replies
7
Views
1K
AndyEd
A
P
  • Question Question
RUNTIME ERROR 91 for USERFORM CODE
Replies
1
Views
113
6StringJazzer
6StringJazzer

Forum statistics

Threads
1,224,602
Messages
6,179,843
Members
452,948
Latest member
UsmanAli786

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top