Hej,
I am trying to design a code, where a number of commandbuttons call the same userform. I have created the class module and got it to work so that they all call the userform, but I need the name of the button passed on from the class module into the userform initialize. I have tried it with property get and a public function, but can't get it to work. The variable I want to pass is the "ScreenShotCap" as string Anyone, who can help?
CLASS MODULE CODE
Option Explicit
Public ScreenShotCap As String
Public WithEvents CmdBtn As MSForms.CommandButton
Property Set obj(btns As MSForms.CommandButton)
'Defines the property of the object called
Set CmdBtn = btns
End Property
Private Sub CmdBtn_Click()
'Gets the button caption
ScreenShotCap = CmdBtn.Name
'Loads the userform
ufScreenshot.Show
End Sub
USERFORM CODE
Private Sub UserForm_Initialize()
Dim btnNo As Variant
Dim imNo1, imNo2, imNo3 As Integer
'Gets the number of the button
btnNo = Right(ScreenShotCap, 1)
'Sets the image number
imNo1 = Int(btnNo + 2)
imNo2 = Int(btnNo + 3)
imNo3 = Int(btnNo + 4)
'Loads the image from MSForms into userform
If ScreenShotCap = Worksheets("SW_TEST").OLEObjects("CommandButton1").Name Then
Application.ScreenUpdating = False
Me.Image1.Picture = Worksheets("SW_TEST").OLEObjects("Image1").Object.Picture
Me.Image2.Picture = Worksheets("SW_TEST").OLEObjects("Image2").Object.Picture
Me.Image3.Picture = Worksheets("SW_TEST").OLEObjects("Image3").Object.Picture
Application.ScreenUpdating = True
Else
Application.ScreenUpdating = False
Me.Image1.Picture = Worksheets("SW_TEST").OLEObjects("Image" & imNo1).Object.Picture
Me.Image2.Picture = Worksheets("SW_TEST").OLEObjects("Image" & imNo2).Object.Picture
Me.Image3.Picture = Worksheets("SW_TEST").OLEObjects("Image" & imNo3).Object.Picture
'after any change vba has to be told to refresh the UserForm for the change to appear
Me.Repaint
Application.ScreenUpdating = True
End If
End Sub
Move the codes in UserForm_Initialize() to a new sub with a parameter or just rename it to:
Public Sub LoadButtonImage(ScreenShotCap As String)
Then in your CmdBtn_Click() sub:
Load ufScreenshot.Show
ufScreenshot.LoadButtonImage CmdBtn.Name
uScreenshot.Show
Related
Once the button is pressed it does not perform the subroutine defined OnAction method.
I have checked all the Security options in Access are enabled and have written the same code in different ways.
I have tried to run a function with the OnAction method instead.
Private Sub Check_Status_Click()
Dim cmdBAR As CommandBar
Dim cmdButton1 As CommandBarButton
Set cmdBAR = CommandBars.Add(, msoBarPopup, False, True)
Set cmdButton1 = cmdBAR.Controls.Add(msoControlButton)
cmdButton1.Caption = "Dale"
cmdButton1.OnAction = "Dale"
cmdBAR.ShowPopup
'Clean
Set cmdBAR = Nothing
Set cmdButton1 = Nothing
End Sub
Public Sub Dale()
MsgBox "hola"
End Sub
I dont get any error, just it is not doing anything even the menu shows up.
Actually OnAction subroutine needs to be
public sub
in public module
So you should change your code to something like this:
...
cmdButton1.Caption = "Dale"
cmdButton1.OnAction = "Dale"
cmdBAR.ShowPopup
...
And place your sub into some public module:
Public Sub Dale()
MsgBox "hola"
End Sub
Can anybody help me what I did wrong here? the controls are not attaching to the Class!
My Class Module: CTglBtn
Option Explicit
Public WithEvents tgl1 As MSForms.ToggleButton
Private ac$
Public Property Get ACNumber() As String
ACNumber = ac
End Property
Public Property Let ACNumber(value As String)
ac = value
End Property
Private Sub tgl1_Click()
' do something here
End Sub
and here is where I am assigning the controls of my form to the class.
Dim Ctgl As CTglBtn
Dim Coll As Collection
Private Sub UserForm_Initialize()
Dim aclist As Range
Set aclist = ThisWorkbook.Sheets("panel").Range("acnum")
For i = 1 To 10
Set Ctgl = New CTglBtn
Set Ctgl.tgl1 = Me.Controls("TB" & i)
Ctgl.ACNumber = aclist.Cells(i + 1, 1)
Me.Controls("TB" & i).Caption = Ctgl.ACNumber
Coll.Add Ctgl
Set Ctgl = Nothing
Next
' MsgBox Coll.Count
End Sub
Dim Coll As Collection needs to be a module-level declaration, otherwise it is cleared as soon as the routine ends.
You also need to initialize that variable:
Set coll = New Collection
I have a worksheet with data in column 'EGM'. My code saves values from this column in the collection.
If there is only one value in the collection, then variable sSelectedEGM is equal to this value.
But if there is more than one values, a user should has possibility to choose only one value (I wanted to do this in the combobox) and save selected item into variable sSelectedEGM.
My problem is, that I can't get values from this collection into userform.
When my code go into useform, the error "Type mismatch" appear. My code in worksheet:
Public sSelectedEGM As String
Public vElement As Variant
Public cEGMList As New VBA.Collection
Sub kolekcjaproba()
' ===================================
' LOOP THROUGH EGMS AND WRITE THEM INTO COLLECTION
' ===================================
Dim iOpenedFileFirstEGMRow As Integer
Dim iOpenedFileLastEGMRow As Integer
Dim iOpenedFileEGMColumn As Integer
Dim iOpenedFileEGMRow As Integer
Dim sOpenedFileEGMName As String
Dim ws As Worksheet
Dim wb As Workbook
Set wb = ThisWorkbook
Set ws = wb.Worksheets(1)
iOpenedFileFirstEGMRow = Cells.Find("EGM").Offset(1, 0).Row
iOpenedFileLastEGMRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, iOpenedFileFirstEGMRow).End(xlUp).Row
iOpenedFileEGMColumn = Cells.Find("EGM").Column
For iOpenedFileEGMRow = iOpenedFileFirstEGMRow To iOpenedFileLastEGMRow
sOpenedFileEGMName = Cells(iOpenedFileEGMRow, iOpenedFileEGMColumn).Value
For Each vElement In cEGMList
If vElement = sOpenedFileEGMName Then
GoTo NextEGM
End If
Next vElement
cEGMList.Add sOpenedFileEGMName
NextEGM:
Next
If cEGMList.Count = 1 Then
sSelectedEGM = cEGMList.Item(1)
ElseIf cEGMList.Count = 0 Then
MsgBox "No EGM found"
Else
Load UserForm1
UserForm1.Show
End If
End Sub
And my code in a userform (There is only a combobox on it)
Private Sub UserForm_Initialize()
For Each vElement In cEGMList
UserForm1.ComboBox1.AddItem vElement
Next vElement
End Sub
Private Sub ComboBox1_Change()
If ComboBox1.ListIndex <> -1 Then
sSelectedEGM = ComboBox1.List(ComboBox1.ListIndex)
End If
End Sub
you have to declare cEGMList and sSelectedEGM in a standard module as public and not in a worksheet module.
Or even better: create a property on the form for the collection and for the returned values. It's always better to avoid global vars wherever possible.
This is a simplified example. In the form you can define properties and methods like that:
Option Explicit
Public TestProperty As Integer
Public Sub TestMethod()
MsgBox (TestProperty)
End Sub
Public Function TestMethodWithReturn() As Integer
TestMethodWithReturn = TestProperty * 2
End Function
outside the form you can then use this as a normal property/method of the form:
Private Sub Test()
Dim retValue As Integer
UserForm1.TestProperty = 123
UserForm1.Show vbModeless
UserForm1.TestMethod
retValue = UserForm1.TestMethodWithReturn
Debug.Print retValue
End Sub
I'm trying struggling to understand how to create a custom event using class modules in VBA.
I've put together the simple following example. You put a value in A1 and B1 and then re activate the sheet to calculate the sum of the two and then I hoped an event would fire to warn of calculation, but nothing happens.
I'd be very grateful for any help solving this example.
Class module cCalc:
Dim m_wks As Worksheet
Public Event BeforeCalc()
Property Set Worksheet(wks As Worksheet)
Set m_wks = wks
End Property
Public Sub Calc()
Dim dVal1 As Double
Dim dVal2 As Double
With m_wks
dVal1 = .Range("A1").Value
dVal2 = .Range("B1").Value
RaiseEvent BeforeCalc
.Range("C1").Value = dVal1 + dVal2
End With
End Sub
In a module mGlobal:
Public gCalc As cCalc
In the code behind Sheet1:
Private WithEvents calcEvent As cCalc
Private Sub calcEvent_BeforeCalc()
MsgBox "About to Calc!", vbInformation
End Sub
Private Sub Worksheet_Activate()
Set gCalc = New cCalc
Set gCalc.Worksheet = ActiveSheet
gCalc.Calc
End Sub
You can't declare event-driven classes in modules. You'll need to set the cCalc reference in gModule equal to the object you declared WithEvents in Sheet1. Change your code in Sheet1 to what i wrote below and it will work:
Private WithEvents calcEvent As cCalc
Private Sub calcEvent_BeforeCalc()
MsgBox "About to Calc!", vbInformation
End Sub
Private Sub Worksheet_Activate()
Set calcEvent = New cCalc 'Instantiate the WithEvents object above
Set mGlobal.gCalc = calcEvent 'Set the object declared in gModule
Set mGlobal.gCalc.Worksheet = ActiveSheet
mGlobal.gCalc.Calc
End Sub
Note that this is using the variable you put in gModule... The event that is actually called is still calcEvent_BeforeCalc(), which is good as this way you can have n number of objects defined in gModule that would all fire off the same event code when the event is triggered.
To simplify the code, you could always just write:
Private Sub Worksheet_Activate()
Set calcEvent = New cCalc
Set calcEvent.Worksheet = ActiveSheet
calcEvent.Calc
End Sub
In excel vba I have added a commandbutton to userform... like below
Set ctrl = Me.Controls.Add( _
bstrProgID:="Forms.CommandButton.1", _
Name:="CommandButton1", Visible:=True)
Now I wanted to know how would I tell it what to do when it is clicked?
This is one of those techniques that vba will let you do, but you probably shouldn't. For all the same reasons you shouldn't use code that alters your code.
That said, here is how to do what you want. First insert a class module and name it DynBtn, then paste this code into it:
Private WithEvents mobjBtn As MSForms.CommandButton
Private msOnAction As String
''// This has to be generic or call by name won't be able to find the methods
''// in your form.
Private mobjParent As Object
Public Property Get Object() As MSForms.CommandButton
Set Object = mobjBtn
End Property
Public Function Load(ByVal parentFormName As Object, ByVal btn As MSForms.CommandButton, ByVal procedure As String) As DynBtn
Set mobjParent = parentFormName
Set mobjBtn = btn
msOnAction = procedure
Set Load = Me
End Function
Private Sub Class_Terminate()
Set mobjParent = Nothing
Set mobjBtn = Nothing
End Sub
Private Sub mobjBtn_Click()
CallByName mobjParent, msOnAction, VbMethod
End Sub
Now to use this in your form, create a blank user form and paste this code into it:
Private Const mcsCmdBtn As String = "Forms.CommandButton.1"
Private mBtn() As DynBtn
Private Sub UserForm_Initialize()
Dim i As Long
ReDim mBtn(1) As DynBtn
For i = 0 To UBound(mBtn)
Set mBtn(i) = New DynBtn
Next
''// One Liner
mBtn(0).Load(Me, Me.Controls.Add(mcsCmdBtn, "Btn1", True), "DoSomething").Object.Caption = "Test 1"
''// Or using with block.
With mBtn(1).Load(Me, Me.Controls.Add(mcsCmdBtn, "Btn2", True), "DoSomethingElse").Object
.Caption = "Test 2"
.Top = .Height + 10
End With
End Sub
Public Sub DoSomething()
MsgBox "It Worked!"
End Sub
Public Sub DoSomethingElse()
MsgBox "Yay!"
End Sub
Private Sub UserForm_Terminate()
Erase mBtn
End Sub