VBA Custom Event Not Found when Raised in UserForm - events

I was following this MSDN guide on creating custom events. I feel like I understand the process now, but I cannot figure out why I am getting a Compile Error: Event Not Found for RaiseEvent ItemAdded. The weird thing is, the ItemAdded event is recognized by the IDE (I can type it in all lowercase and it is then automatically formatted properly), so I know that it is recognized by VB.
DataComboBox Class Module Code:
Public Event ItemAdded(sItem As String, fCancel As Boolean)
Private pComboBox As Control
Public Property Set oComboBox(cControl As Control)
Set pComboBox = cControl
End Property
Public Property Get oComboBox() As Control
oComboBox = pComboBox
End Property
Private Sub Class_Initialize()
End Sub
Private Sub Class_Terminate()
End Sub
The UserForm contains two controls - a CommandButton named btnAdd and a ComboBox named cboData.
UserForm Code:
Private WithEvents mdcbCombo As DataComboBox
Private Sub UserForm_Initialize()
Set mdcbCombo = New DataComboBox
Set mdcbCombo.oComboBox = Me.cboData
End Sub
Private Sub mdcbCombo_ItemAdded(sItem As String, fCancel As Boolean)
Dim iItem As Long
If LenB(sItem) = 0 Then
fCancel = True
Exit Sub
End If
For iItem = 1 To Me.cboData.ListCount
If Me.cboData.List(iItem) = sItem Then
fCancel = True
Exit Sub
End If
Next iItem
End Sub
Private Sub btnAdd_Click()
Dim sItem As String
sItem = Me.cboData.Text
AddDataItem sItem
End Sub
Private Sub AddDataItem(sItem As String)
Dim fCancel As Boolean
fCancel = False
RaiseEvent ItemAdded(sItem, fCancel)
If Not fCancel Then Me.cboData.AddItem (sItem)
End Sub

You cannot raise an event outside the classes file level.
Add a routine like this inside "DataComboBox1" to allow you to raise the event externally.
Public Sub OnItemAdded(sItem As String, fCancel As Boolean)
RaiseEvent ItemAdded(sItem, fCancel)
End Sub
Then call the OnItemAdded with the current object.
Example...
Private WithEvents mdcbCombo As DataComboBox
...
mdcbCombo.OnItemAdded(sItem, fCancel)

Related

VB6 How to return a string value from form2 to form 1

in my project there are two forms:
first form i named it frmSettings , i will use text boxes to save values in INI file.
second form i named it frmSelectFolder , i had included with DirListBox and 2 Command buttons
as shown in attached image above in Settings form i have 8 text boxes and 8 command buttons to browse for folder path that it will be selected from frmSelectFolder
how to use frmSelectFolder for all text boxes without duplicating this form per each command button to return DirlistBox Control value ?
Here is some sample code for secondary frmSelectFolder form
Option Explicit
Private m_bConfirm As Boolean
Public Function Init(sPath As String) As Boolean
Dir1.Path = sPath
Show vbModal
If m_bConfirm Then
sPath = Dir1.Path
'--- success
Init = True
End If
Unload Me
End Function
Private Sub cmdOk_Click()
If LenB(Dir1.Path) = 0 Then
MsgBox "Please select a path!", vbExclamation
Exit Sub
End If
m_bConfirm = True
Visible = False
End Sub
Private Sub cmdCancel_Click()
Visible = False
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If UnloadMode <> vbFormCode Then
Cancel = 1
Visible = False
End If
End Sub
Here is how to call Init method above from primary frmSettings
Option Explicit
Private Sub cmdStartupPath_Click()
Dim sPath As String
Dim oFrmSelector As New frmSelectFolder
sPath = txtStartupPath.Text
If oFrmSelector.Init(sPath) Then
txtStartupPath.Text = sPath
txtStartupPath.SetFocus
End If
End Sub
Private Sub cmdDownloadPath_Click()
Dim sPath As String
Dim oFrmSelector As New frmSelectFolder
sPath = txtDownloadPath.Text
If oFrmSelector.Init(sPath) Then
txtDownloadPath.Text = sPath
txtDownloadPath.SetFocus
End If
End Sub
Here is a link to a complete sample project for you to research: SelectFolder.zip

Sub or Function is not defined vb6

Why am I getting an error "Sub or Function is not defined"...Here is my code
FORM2
Option Explicit
Public Report As New CrystalReport1
Public mvCn As New ADODB.Connection
Public Function printReport()
Dim strConnectionString As String
Dim rs As ADODB.Recordset
Dim strScript As String
strConnectionString = "Provider=SQLOLEDB............"
mvCn.ConnectionString = strConnectionString
mvCn.CommandTimeout = 0
mvCn.CursorLocation = adUseClient
mvCn.Open
strScript = strScript & "SELECT * FROM employee" & vbCrLf
Set rs = mvCn.Execute(strScript)
Report.Database.SetDataSource rs
Report.AutoSetUnboundFieldSource crBMTNameAndValue
CRViewer1.ReportSource = Report
CRViewer1.ViewReport
Set Report = Nothing
End Function
Form 1.....Call my function "printReport" here
Option Explicit
Private Sub Command1_Click()
printReport
End Sub
The error message goes here "Private Sub Command1_Click()"
Where is your printReport function defined? If it's in a class module, then you need to instantiate an instance of the class then call printReport as a method of that class. For instance:
Private Sub Command1_Click()
Dim oClass As New Class1
oClass.printReport
End Sub
Or you can place your printReport function in a module, then you don't instantiate it or call it as a method - you would instead call it as you have in your click event.
A procedure can be called in such a simple way.[As you have called is correct]
Eg.
Private Sub Form_Load()
Test1
End Sub
Sub Test1()
MsgBox "Test1"
End Sub

Comma, ')', or a valid expression continuation expected - Registry Error

I am creating a start-up 2nd level logon screen for businesses and corporate companies to use. However, I am trying to disable using Task Manager by using a Registry DWORD Value. When I add in the code, it comes up with the error "Comma, ')', or a valid expression continuation expected". What can I do?
Imports Microsoft.Win32
Public Class Form1
Dim regKey As RegistryKey
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
regKey = Registry.CurrentUser.OpenSubKey("regKey.SetValue("***HKEY***\SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System")
regKey.SetValue("DisableTskMgr", 1, RegistryValueKind.DWord)
End Sub
Private Sub frmMyform_FormClosing(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
Dim Cancel As Boolean = eventArgs.Cancel
Dim UnloadMode As System.Windows.Forms.CloseReason = eventArgs.CloseReason
If UnloadMode = CloseReason.UserClosing Then
Cancel = True
End If
End Sub
End Class
My problem is with the HKEY system above. Thanks in advance!
I think this should look like this:
regKey = Registry.CurrentUser.OpenSubKey( "regKey.SetValue(""***HKEY***\SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System"")" )
See Escape double quote in VB string
MsgBox("""") ' Prints a single "

visual basic 6 Image Class

The following code is the Form code which changes an image or informs the user if the image has already changed. In the form, I have an Image control named Image1 whose Picture property has to be changed. I'm just asking for help on how to make a class module(.cls) from this code.
Private Image1Color As String
Private Sub Form_Load()
Image1Color = "Green"
End Sub
Private Sub CheckIn1_Click()
If Image1Color = "Green" Then
Image1.Picture = LoadPicture ("Color\red1.jpg")
Image1Color = "Red"
Else
MsgBox ("This table is already occupied")
End If
End Sub
If you want to literally reuse your form code you can do the following:
ImageControlWrapper.cls:
Private m_ksColor_Green As String = "Green"
Private m_ksColor_Red As String = "Red"
Private m_sImageColor As String
Private WithEvents m_oImageControl As Image
Private Sub Class_Initialize()
m_sImageColor = m_ksColor_Green
End Sub
Public Sub Attach(ByRef in_oImageControl As VB.Image)
Set m_oImageControl = in_oImageControl
End Sub
Private Sub m_oImageControl_Click()
If m_sImageColor = m_ksColor_Green Then
Set m_oImageControl.Picture = LoadPicture("Color\red1.jpg")
m_sImageColor = m_ksColor_Red
Else
MsgBox "This table is already occupied"
End If
End Sub
Test.frm:
Private m_oImageControlWrapper As ImageControlWrapper
Private Sub Form_Load
Set m_oImageControlWrapper = New ImageControlWrapper
m_oImageControlWrapper.Attach Image1
End Sub
I used string constants for the color purely so that the compiler can pick up a mistake if you mispell the constant. If you mispell the actual string, that's an annoying bug to fix. However, if you don't really need to use the string, you would be better off turning m_sImageColor into a Boolean or an enumerated type.

VBA: WithEvents puzzle

I have a UserForm, xForm, that is being instantiated in a class module (let's say TestClass) as:
'TestClass
Dim Form as New xForm
Private WithEvents EvForm as MSForms.UserForm
Set EvForm = Form
At the class module of the xForm itself I have some code that must be executed on Form Closing, ONLY if the form actually closes:
'xForm class module
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
'Do some cleanup, otherwise the app would hang
'If not closing, don't cleanup anything, otherwise the app would hang
End Sub
The QueryClose event is also treated in TestClass, and could avoid the form from closing:
'TestClass
Private Sub EvForm_QueryClose(Cancel As Integer, CloseMode As Integer)
'Verify if closing is allowed based on User Control values
Cancel = Not ClosingIsAllowed '<-- Pseudocode on the right side of "="
End Sub
How can I test for Cancel = True, set in TestClass, in the xForm class module?
Let's rephrase it: If Cancel is set to True in TestClass, I must not do the cleanup code in the xForm class module. How can I accomplish that?
Until now, I have thought off of implementing another event in the xForm class (My_QueryClose?) and raise it on the QueryClose event. Outside the Code Behind Form I would deal only with the My_QueryClose event, so taking full control over what is happening. Is this a viable/better approach?
Can't make heads or tails of your custom event idea, but the way to get one class to talk to another (form or anything else, doesn't matter) is to link them up; here's a clean example:
Basic TestClass holds form object (no events needed here, let the form handle that)
'TestClass code
Private MyForm As UserForm
Private mbleCanClose As Boolean
Public Property Get CanClose() As Boolean
CanClose = mbleCanClose
End Property
Public Property Let CanClose(pbleCanClose As Boolean)
mbleCanClose = pbleCanClose
End Property
Public Property Get MyFormProp() As UserForm1
Set MyFormProp = MyForm
End Property
Add a custom object and property to the form itself
'UserForm1 code
Private mParent As TestClass
Public Property Get Parent() As TestClass
Set Parent = mParent
End Property
Public Property Set Parent(pParent As TestClass)
Set mParent = pParent
End Property
Invoking the form on TestClass creation looks like this:
'TestClass code
Private Sub Class_Initialize()
Set MyForm = New UserForm1
Load MyForm
Set MyForm.Parent = Me
End Sub
And then when it's time to close the form, you check whether you can:
'UserForm1 code
Public Function WillMyParentLetMeClose() As Boolean
If Not (mParent Is Nothing) Then
WillMyParentLetMeClose = mParent.CanClose
End If
End Function
Private Sub CommandButton1_Click()
If WillMyParentLetMeClose = True Then
Unload Me
End If
End Sub
Here's what it would like to invoke
'standard module code
Public Sub Test_TestClass()
Dim myclass As TestClass
Set myclass = New TestClass
myclass.MyFormProp.Show
End Sub
A work around declaring another event
The code bellow do what I was expecting, although it is not as neat as I wish it could be.
In the UserForm1 code:
'***** UserForm1
Public Event MyQueryClose(ByRef Cancel As Integer, ByRef CloseMode As Integer, ByRef Status As String)
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Dim Status As String
Cancel = True
Status = "QueryClose"
Debug.Print "Entered QueryClose"
Debug.Print "Cancel = " & Cancel
Debug.Print "Status = " & Status
Debug.Print "Just before raising MyQueryClose"
RaiseEvent MyQueryClose(Cancel, CloseMode, Status)
Debug.Print "Just got back from MyQueryClose"
Debug.Print "Cancel = " & Cancel
Debug.Print "Status = " & Status
End Sub
In the Class1 code:
'***** Class1
Dim UserForm As New UserForm1
Private WithEvents UF As UserForm1
Sub DoIt()
Set UF = UserForm
UserForm.Show
End Sub
Private Sub UF_MyQueryClose(Cancel As Integer, CloseMode As Integer, Status As String)
Debug.Print "Just entered MyQueryClose"
Cancel = False
Status = "MY QueryClose"
End Sub
In a basic module, to test the Class:
'***** Basic module
Sub TestClass()
Dim C As New Class1
C.DoIt
End Sub
And here's the end result (debug window):
TestClass
Entered QueryClose
Cancel = -1
Status = QueryClose
Just before raising MyQueryClose
Just entered MyQueryClose
Just got back from MyQueryClose
Cancel = 0
Status = MY QueryClose

Resources