I'm trying to pass an object to a new sub but keep hitting a ByRef Mismatch error.
I've declared my object as:
Dim targetWorkbook
Set targetWorkbook = New CWorkbooks
I'm calling my sub by using:
checkbook targetWorkbook
And my sub is set as:
Sub checkbook(targetWorkbook As CWorkbooks)
'Checking if passthrough is working
End Sub
Any help is appreciated, my types are aligned and everything so I'm not sure why this is occuring.
Thanks!
Sub Foo()
'single class object
Dim myClass1 As New clsClass
myClass1.StringName = "cls1"
Call Par(myClass1)
'or class array
Dim myClass2(1 To 5) As New clsClass
myClass2(1).StringName = "cls2"
Call Par(myClass2)
End Sub
Sub Par(ByRef lClass As Variant) 'same function call used for both
'Debug.Print lClass.StaffName & vbNewLine 'single class object
'Debug.Print lClass(1).StaffName & vbNewLine 'array version
End Sub
google brought me here for same problem but found the accepted answer lacking & didn't work at all in my case where Foo() was a module & Par() a worksheet, trying to pass class array.
I was able to duplicate your problem with the compiler. The following passes the compiler and runs. You declared TargetWorkbook as Variant, then set it to CWorkbooks - this works, but not when passed to the sub.
Sub main()
Dim TargetWorkbook As CWorkbooks
Set TargetWorkbook = New CWorkbooks
checkbook TargetWorkbook
End Sub
Sub checkbook(ByRef TargetWorkbook As CWorkbooks)
'Checking if passthrough is working
End Sub
Related
I'm familiar with passing an argument to a procedure by reference. Alternately, ParamArray allows me the flexibility of passing 0 or more arguments to a procedure by reference as well. However, that approach made me wonder if there was a way to preserve a reference to one or more variables beyond the scope of a procedure. My first glimmer of hope was the VBA Array function when I saw it was declared like this:
Array(ParamArray ArgList() As Variant)
So, I put together the following test code:
Private Sub Test()
Dim a As Object
Dim b() As Variant
ParamArrayTest a
Debug.Print TypeName(a) ' Output is 'Dictionary'
b = Array(a) ' b should be like ParamArray ArgList()
Set b(0) = Nothing ' This should clear a
Debug.Print TypeName(a) ' Output is still 'Dictionary'
End Sub
Private Sub ParamArrayTest(ParamArray ArgList() As Variant)
Set ArgList(0) = CreateObject("Scripting.Dictionary")
End Sub
Unfortunately, this did not work as I expected. Despite the argument being passed into the Array function via ParamArray, it would appear that the returned array was by value and not by reference.
Further research led me to the undocumented VBA VarPtr / StrPtr / ObjPtr functions. I found numerous examples of using them in conjunction with the API RtlMoveMemory function. However, all of the articles I read strongly urged against using that approach since it could very easily crash the application. Some of my testing did indeed crash Access.
Another idea I had was to see if I could directly assign a reference of one variable to another:
Private Sub Test()
Dim a As Object
Dim b As Variant
b = ByRef a ' Throws a compiler error
End Sub
Suffice it to say, the compiler simply would not allow that. My question then is, can a variable reference be safely stored / preserved beyond the scope of a procedure (preferably in another variable)?
EDIT
I decided it would be more helpful if I shed some light on what I'm trying to build.
I'm currently in the process of creating a wrapper class which will pass all form / control events to a procedure in one of my modules. It will be used with 2 forms which have the same control structure but connect to different source tables. Bear in mind that the code is incomplete but should be sufficient to illustrate the problem I'm trying to overcome. Also, Database is my VBA project name.
There are four portions to the code:
Form_TEST_FORM - Form Module
Private Sub Form_Open(Cancel As Integer)
FormHub.InitForm Me, Cancel
End Sub
FormHub - Module
Public Sub InitForm( _
ByRef Form As Access.Form, _
ByRef Cancel As Integer _
)
Dim Evt As Database.EventHandler
Set Evt = New Database.EventHandler
Evt.InitFormObject Form, Cancel
FormList.Add Evt, Form.Name
End Sub
Private Function FormList() As VBA.Collection
Static Init As Boolean
Static Coll As VBA.Collection
If Not Init Then
Set Coll = New VBA.Collection
Init = True
End If
Set FormList = Coll
End Function
FormControl - Class Module
Public Ptr As Variant ' Pointer to form control variable
Public acType As Access.AcControlType
EventHandler - Class Module
Private WithEvents Form As Access.Form
Private WithEvents SForm As Access.SubForm
Private CtrlList As VBA.Collection
Private Sub Class_Initialize()
InitCtrlList
End Sub
Public Sub InitFormObject(FormObj As Access.Form, ByRef Cancel As Integer)
Dim ErrFlag As Boolean
Dim Ctrl As Access.Control
Dim FCtrl As Database.FormControl
On Error GoTo Proc_Err
Set Form = FormObj
If Form.Controls.Count <> CtrlList.Count Then
Err.Raise 1, , _
"Form has incorrect number of controls"
End If
' This is where I want to validate the form controls
' and also initialize my event variables.
For Each Ctrl In Form.Controls
If Not CtrlExists(FCtrl, Ctrl.Name) Then
Err.Raise 2, , _
"Invalid control name"
ElseIf FCtrl.acType <> Ctrl.ControlType Then
Err.Raise 3, , _
"Invalid control type"
Else
' Initialize the correct variable with it's
' pointer. This is the part I haven't been
' able to figure out yet.
Set FCtrl.Ptr = Ctrl
End If
Next
Proc_End:
On Error Resume Next
If ErrFlag Then
ClearEventVariables
End If
Set Ctrl = Nothing
Set FCtrl = Nothing
Exit Sub
Proc_Err:
ErrFlag = True
Debug.Print "InitFormObject " & _
"Error " & Err & ": " & Err.Description
Resume Proc_End
End Sub
Private Function CtrlExists( _
ByRef FCtrl As Database.FormControl, _
ByRef CtrlName As String _
) As Boolean
On Error Resume Next
Set FCtrl = CtrlList(CtrlName)
CtrlExists = Err = 0
End Function
Private Sub InitCtrlList()
Set CtrlList = New VBA.Collection
CtrlList.Add SetCtrlData(SForm, acSubform), "SForm"
End Sub
Private Function SetCtrlData( _
ByRef Ctrl As Access.Control, _
ByRef acType As Access.AcControlType _
) As Database.FormControl
Set SetCtrlData = New Database.FormControl
With SetCtrlData
' This assignment is where I need to keep a reference
' to the variable in the class. However, it doesn't
' work.
Set .Ptr = Ctrl
.acType = acType
End With
End Function
Private Sub ClearEventVariables()
Dim FormCtrl As Database.FormControl
Set Form = Nothing
For Each FormCtrl In CtrlList
' Assuming I was able to retain a reference to the
' class variable, this would clear it.
Set FormCtrl.Ptr = Nothing
Next
End Sub
Private Sub Class_Terminate()
ClearEventVariables
Set CtrlList = Nothing
End Sub
I only used 1 control in the code example for simplicity sake. But, the idea is to simplify how much code I would need to modify in order to add / remove controls should the form design change. Or, in the event I have to add more forms to the project.
If you need to reference only within a single module, declare as Public in module header. If you want to reference in any module, declare as Global in a general module header. Even array and recordset and connection objects can be declared this way. Be aware these variables will lose their values if code breaks in runtime.
Or look into TempVar object variables. They don't lose values if code breaks. But can only store number or text values, not objects.
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
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.
I really don't know the syntax of the DocumentBeforeClose event. Following this page, I should create a class module called 'EventClassModule' (see also this article). So I did. Then I copied this piece of code (from the example of the first link) into that (class)module:
Public WithEvents appWord as Word.Application
Private Sub appWord_DocumentBeforeClose _
(ByVal Doc As Document, _
Cancel As Boolean)
Dim intResponse As Integer
intResponse = MsgBox("Do you really " _
& "want to close the document?", _
vbYesNo)
If intResponse = vbNo Then Cancel = True
End Sub
And finally I put this in a normal module, and executed it:
Dim X As New EventClassModule
Sub Register_Event_Handler()
Set X.App = Word.Application
End Sub
What does the 'X' means in this case, and what am I doing wrong? There is no event executed when I close the document now.
X is an instance of the class you created (EventClassModule)
Your problem is that .App is not a property of EventClassModule. Change
Set X.App = Word.Application
to the property you defined in your class
Set X.appWord = Word.Application
I tried the same thing! Actually it works for me. I have this in a class module named EventClassModule
Public WithEvents appWord As Word.Application
Private Sub appWord_DocumentBeforeClose _
(ByVal Doc As Document, _
Cancel As Boolean)
'Here is the code you want to do before it close
MsgBox "WORKING!"
End Sub
And in a module (not a class module) I have this
Dim X As New EventClassModule
Sub AutoExec()
'Call any other sub or function you want
Call Register_Event_Handler
End Sub
Sub Register_Event_Handler()
Set X.appWord = Word.Application
End Sub
AutoExec is called as soon as the document is loaded. So it calls the sub Register_Event_Handler to register the object X (which is a object EventClassModule, the class module created). So X will be annonced that the document is about to close
hope it helps!