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
Related
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
On the UserForm_Activate() code, I want to call a function (which has not been created yet) that will set scroll properties of the Userform. See code below.
Private Sub UserForm_Activate()
MakeFormResizable
End Sub
On the Modules4 sheet, I have the following code:
Public Sub MakeFormResizable()
Me.ScrollHeight = .Height
Me.ScrollWidth = .Width
End Sub
When I run the code that I have pasted, I get the error "Compile error: Invalid or unqualified reference."
It will not work as Me is local ….
Perhaps you want to pass the Userform object to a Public sub, as follows:
Public Sub MakeFormResizable(ByRef aUserform As MSForms.UserForm)
With aUserform
'Do your stuff
End With
End Sub
Got it!
Private Sub UserForm_Activate()
Dim MyObject
Set MyObject = Me
MakeFormResizable MyObject
End Sub
Public Sub MakeFormResizable(MyObject)
With MyObject
.ScrollHeight = .Height
End If
End With
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
I'm trying to use the .OnTime method in a class module, but can't figure out how to call a procedure in the class. All of the .OnTime examples I've seen refer to using the method from a standard code module rather than a custom class. Is there any way of calling a procedure in the class module rather than a standard code module?
#Alex P: Updated to include code. Here is the Class Module:
Option Explicit
Public Sub Test()
MsgBox "Success"
End Sub
Private Sub Class_Initialize()
Application.OnTime EarliestTime:=Now + TimeValue("00:00:03"), _
Procedure:="Test"
End Sub
And the Standard Module:
Option Explicit
Public Sub TestOnTime()
Dim OnTime As CCOnTime
Set OnTime = New CCOnTime
End Sub
I've also tried Procedure:="CClass.Test"
You can do it, but the call-back needs to be bounced back into the object from a Standard Module or a Worksheet Module or Thisworkbook.
Here is an example that pulses a value in a worksheet cell.
The timer is (almost) encapsulated in the cOnTime Class.
A cOnTime Object is instantiated in the host worksheet, whose code module can have a property to set the pulse time as well as the call-back routine.
If you protect the sheet, it will start pulsing and you can stop it by un-protecting the sheet.
If you navigate away from the host sheet, the timer is killed and if you navigate back it re-starts (as long as the sheet is protected).
Class cOnTime
Option Explicit
Const DEFPulseTime = "PulseTime"
Const DEFearliestTime As Long = 5
Const DEFlatestTime As Long = 15
Public WithEvents wb As Workbook
Public ws As Worksheet
Private DoWhen As String
Public mPulseTime As Long
Public mNextTime As Double
Property Let callBackDoWhen(cb As String)
DoWhen = "'" & wb.Name & "'!" & ws.CodeName & "." & cb 'e.g. 'wb Name.xlsm'!Sheet1.kickdog
End Property
Private Function PulseTime() As Long
On Error Resume Next
PulseTime = CallByName(ws, DEFPulseTime, VbGet)
If Err.number <> 0 Then
PulseTime = DEFearliestTime
End If
On Error GoTo 0
End Function
Property Get designMode() As Boolean
designMode = Not ws.ProtectContents
End Property
Public Sub kickDog()
Const myName As String = "kickDog"
Dim psMessage As String
If ws Is ActiveSheet And Not designMode Then
mNextTime = Now + TimeSerial(0, 0, mPulseTime)
On Error Resume Next
Application.OnTime mNextTime, DoWhen
On Error GoTo 0
End If
Exit Sub
End Sub
Public Sub killDog()
If ws Is Nothing Or mNextTime = 0 Then Exit Sub
On Error Resume Next
Application.OnTime mNextTime, DoWhen, , False
On Error GoTo 0
End Sub
Private Sub Class_Initialize()
Dim errorContext As String
On Error GoTo enableAndExit
Set wb = ActiveWorkbook
Set ws = ActiveSheet
On Error GoTo 0
callBackDoWhen = DEFDoWhen
callBackPulseTime = DEFPulseTime
mPulseTime = PulseTime
kickDog
Exit Sub
enableAndExit:
If Err <> 0 Then
If ws Is Nothing Then
errorContext = "ws"
ElseIf wb Is Nothing Then
errorContext = "wb"
End If
End If
End Sub
Private Sub Class_Terminate()
Const myName As String = "Class_Terminate"
On Error Resume Next
killDog
Set ws = Nothing
Set wb = Nothing
Exit Sub
End Sub
Private Sub wb_WindowActivate(ByVal Wn As Window)
wb_Open
End Sub
Private Sub wb_WindowDeactivate(ByVal Wn As Window)
killDog
End Sub
Private Sub wb_BeforeClose(Cancel As Boolean)
killDog
End Sub
Private Sub wb_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If SaveAsUI Then killDog
End Sub
In Worksheet Module
Option Explicit
Const cPulseTime As Long = 1
Dim mOnTime As cOnTime
Property Get PulseTime() As Long
PulseTime = cPulseTime
End Property
'****************************************
'Timer call-back for cOnTime
Public Sub kickDog()
' Code to execute on timer event
'******************************************
On Error Resume Next
Me.Cells(1, 1) = Not Me.Cells(1, 1)
On Error GoTo 0
'******************************************
Debug.Print "woof!!"
mOnTime.kickDog
End Sub
Private Sub Worksheet_Activate()
Me.Cells(1,1) = False
Set mOnTime = New cOnTime
End Sub
Private Sub Worksheet_Deactivate()
On Error Resume Next
Set mOnTime = Nothing
End Sub
You are asking for magic - VBA is a comprehensive tool but it is not magic.
The reason is that every Class module is simply a template which can be instantiated any number of times in the application code. Excel could not hope to correctly guess which particular instantiation of the Class module is the correct one on which to invoke the method. You are responsible for making this decision and managing the references to the appropriate Class instance.
Ah you say - But there is no private data/references being used by the method I want called. It is a static method. Well the answer to that is that VBA does not support static methods on Class modules, only on Standard modules. Any method that you wish to declare to the environment as being static is declared as being static by being included in a standard module.
So, place your call-back method in a Standard module, and declare a private member that holds a reference to the particular instance of the Class that you wish to handle the event.
One alternative route which isn't specified by others here but, I think, would theoretically work is:
Register VBA object as an active object with a specified GUID
Launch a PowerShell (or binary) daemon to connect to the object with specified GUID and call a specified method on that object every n seconds.
Pros:
Totally encapsulated
Cons:
Launches external process
Method likely has to be public (unless connection points can be abused)
Potentially crash-prone
I haven't implemented such a solution yet but intend to on stdCOM of stdVBA library if everything works out.
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