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.
Related
I am able to format my dtpicker using below code.
Private Sub Form_Load()
DTPicker1.Format = dtpCustom
DTPicker1.CustomFormat = "yyyy/MM/dd"
DTPicker1.Value = Format(Date, "yyyy/MM/dd")
End Sub
After get dtpicker value using below code
Private Sub Command1_Click()
Label34.Caption = DTPicker1.Value
End Sub
But result is not formatted like as dtpicker displayed value.
Dtpicker value : 2015/05/26
Label34 Value : 05/26/2015
How to rectify this issue ...?
Use format function (same you did for DatePicker) when assigning value to your label :
Private Sub Command1_Click()
Label34.Caption = Format(DTPicker1.Value, "yyyy/MM/dd")
End Sub
Or even better, get format from DatePicker:
Private Sub Command1_Click()
Label34.Caption = Format(DTPicker1.Value, DTPicker1.CustomFormat)
End Sub
I don't remember, but maybe DatePicker has a property giving you its value as text (having the correct format).
I have created a dialer in VB6 to dial a phone number. It has the following buttons: the digits 0-9, backspace, "Call", and "Disconnect". Now I want enter numbers in the form using the keypad part of the keyboard. In the text box, any key can be typed in using the keypad. But I only want the number pad to operate.
For that I checked ASCII values using the KeyPress event - seeing if the pressed key value lies in between 47 and 58. But along with the key values its ASCII values are also getting displayed in the text box.
One more thing - I have one MS Flex Grid on the form along with the dialer. So when the cursor is on the form, or if the mouse is clicked anywhere other than the text box, values don't display in the text box. So how do I always keep focus on the text box?
Dim val As Integer
Private Sub append(val As Integer)
Text1.Text = Text1.Text & val
End Sub
Private Sub Backspace_Click()
With Text1
'FOCUS TO THE TEXTBOX
.SetFocus
'PUT THE CURSOR AT THE END OF THE TEXT
.SelStart = Len(.Text)
'SEND THE KEY
SendKeys ("{BACKSPACE}")
'AND THATS IT :D
End With
End Sub
Private Sub key_0_Click()
val = 0
append val
End Sub
Private Sub key_1_Click()
val = 1
append val
End Sub
Private Sub key_2_Click()
val = 2
append val
End Sub
Private Sub key_3_Click()
val = 3
append val
End Sub
Private Sub key_4_Click()
val = 4
append val
End Sub
Private Sub key_5_Click()
val = 5
append val
End Sub
Private Sub key_6_Click()
val = 6
append val
End Sub
Private Sub key_7_Click()
val = 7
append val
End Sub
Private Sub key_8_Click()
val = 8
append val
End Sub
Private Sub key_9_Click()
val = 9
append val
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
If (KeyAscii > 47 And KeyAscii < 58) Then
val = KeyAscii
append val
Else
KeyAscii = 0
' Text1.Text = KeyAscii
End If
End Sub
'Private Sub Text1_LostFocus()
' Text1.SetFocus
'End Sub
You could set the KeyPreview property on the form to true.
When you have done that, put your code in the KeyPress of the form that was in the KeyPress of the Textbox, and set the text value of the textbox, or better still move the code into a function and set it from there, that way you won't need to duplicate your code if you need it in other places.
Have a look at this and see if it helps it is the KeyPreview from MSDN
Hi,
Sorry for the delay. To use the KeyPreview for the form give this a try:
Double click on the form in the project to open it
In the properties for the form find the KeyPreview Property and set it to true
Double click on the form to bring up the code window
Select the keypress event for the form, and add the following code, or something similar.
Private Sub Form_KeyPress(KeyAscii As Integer)
Text1.Text = Text1.Text & Chr$(NrOnly(KeyAscii))
End Sub
Use the function NrOnly that Hqrls has posted as that will allow only numbers which could help you with the validation. You won't need any code in the Text1_KeyPress, the form will now handle that for you.
Give it a try and let me know if you need any other information and I'll see what I can do.
[EDIT 29/05/2014]
Hi,
I've had a bit of a play around with the code and added some bits in which I think might help. Have a look at this and see if it make sense. If you copy it into your code then make sure you back up your original code just in case you need to get back to it.
This is the code if you keep your textbox
Option Explicit
Dim val As String
Dim m_blnTextHasFocus As Boolean 'Added this, so it knows wether the the textbox
'has the focus or not
'it is so the sendkeys doesn't get stuck in a
'loop with the key presses
Private Sub append(strIn As String)
'Changed the parameter from an int to a string, so we can use it in the key press events
Text1.Text = Text1.Text & strIn
End Sub
Private Sub Backspace_Click()
'Moved the code into it's own sub
DeleteAChar
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
'Handle a key press if the textbox doesn't have the focus but ignore the keypress if it does
If Not m_blnTextHasFocus Then
If IsNumeric(Chr$(KeyAscii)) Then
append Chr$(KeyAscii)
ElseIf KeyAscii = vbKeyBack Then
DeleteAChar
End If
End If
End Sub
Private Sub key_0_Click()
val = "0"
append val
End Sub
Private Sub key_1_Click()
val = "1"
append val
End Sub
Private Sub key_2_Click()
val = "2"
append val
End Sub
Private Sub key_3_Click()
val = "3"
append val
End Sub
Private Sub key_4_Click()
val = "4"
append val
End Sub
Private Sub key_5_Click()
val = "5"
append val
End Sub
Private Sub key_6_Click()
val = "6"
append val
End Sub
Private Sub key_7_Click()
val = "7"
append val
End Sub
Private Sub key_8_Click()
val = "8"
append val
End Sub
Private Sub key_9_Click()
val = "9"
append val
End Sub
Private Sub Text1_GotFocus()
m_blnTextHasFocus = True
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
'Check the keyascii value and ignore it if it isn't numeric or backspace
If Not IsNumeric(Chr$(KeyAscii)) And KeyAscii <> vbKeyBack Then
KeyAscii = 0
End If
End Sub
Private Sub DeleteAChar()
With Text1
'FOCUS TO THE TEXTBOX
.SetFocus
'PUT THE CURSOR AT THE END OF THE TEXT
.SelStart = Len(.Text)
'SEND THE KEY
SendKeys ("{BACKSPACE}")
'AND THATS IT :D
End With
End Sub
Private Sub Text1_LostFocus()
m_blnTextHasFocus = False
End Sub
If you don't need to keep the textbox then you could replace it with a label and have a try with that. It would remove the need to keep track of if the textbox has got the focus or not. Have a go with this and see if it helps any. The only other thing is to make sure KeyPreview is turned on for the form or the keypress code will only work for the form if it has the focus.
Is the textbox the only control you want to have the focus ?
In that case you can use the following code:
Private Sub Text1_LostFocus()
Text1.SetFocus
End Sub
If there are any other controls you want to be able to have the focus as well, then you can use Text1.SetFocus in the _GotFocus() event of the controls which you do not want to have the focus
Another possible solution would be to use the _KeyPress() event of the other controls as well, and convert your current Text1_KeyPress() event to a general function which can be called by the _KeyPress() event of the other controls .. make sure though that you send the output of this general function to the correct textbox
If you post the relevant parts of your code we might be able to give a more specific answer
[EDIT]
for the answer to your original question, go with the answer of lardymonkey using keypreview on the form
an example function for allowed only numeric keys and the backspace:
Private Sub Text1_KeyPress(KeyAscii As Integer)
KeyAscii = NrOnly(KeyAscii)
End Sub
Private Function NrOnly(intAscii As Integer) As Integer
Dim intReturn As Integer
intReturn = intAscii
Select Case intAscii
Case vbKeyBack
Case vbKey0 To vbKey9
Case Else
intReturn = 0
End Select
NrOnly = intReturn
End Function
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)
I am creating a excel sheet that would autocomplete a text based on the text present in a particular column. After trying to make one myself unsuccessfully, I was looking online for sample codes that I could modify and incorporate in my program. (and not plagiarize)
I downloaded Workbook1.xls from http://www.ozgrid.com/forum/showthread.php?t=144438
The code is
Option Explicit
Dim ufEventsDisabled As Boolean
Dim autoCompleteEnabled As Boolean
Dim oRange As Range
Private Sub TextBox1_Change()
If ufEventsDisabled Then Exit Sub
If autoCompleteEnabled Then Call myAutoComplete(TextBox1)
End Sub
Sub myAutoComplete(aTextBox As MSForms.TextBox)
Dim RestOfCompletion As String
On Error GoTo Halt
With aTextBox
If .SelStart + .SelLength = Len(.Text) Then
RestOfCompletion = Mid(oRange.Cells(1, 1).AutoComplete(.Text), Len(.Text) + 1)
ufEventsDisabled = True
.Text = .Text & RestOfCompletion
.SelStart = Len(.Text) - Len(RestOfCompletion)
.SelLength = Len(RestOfCompletion)
End If
End With
Halt:
ufEventsDisabled = False
On Error GoTo 0
End Sub
Private Sub TextBox1_AfterUpdate()
Dim strCompleted As String
With TextBox1
strCompleted = oRange.AutoComplete(.Text)
If LCase(strCompleted) = LCase(.Text) Then
ufEventsDisabled = True
.Text = strCompleted
ufEventsDisabled = False
End If
End With
End Sub
Private Sub TextBox1_Enter()
Set oRange = ThisWorkbook.Sheets("Sheet1").Range("f4")
End Sub
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
autoCompleteEnabled = KeyCode <> vbKeyBack
autoCompleteEnabled = ((vbKey0 <= KeyCode) And (KeyCode <= vbKeyZ))
End Sub
Private Sub CommandButton1_Click()
Unload Me
End Sub
Private Sub UserForm_Click()
End Sub
If you'd notice the line RestOfCompletion = Mid(oRange.Cells(1, 1).AutoComplete(.Text), Len(.Text) + 1), I was wondering what AutoComplete is doing here. Its not a in built function and is not defined anywhere. Still the code runs fine. I am very curious.
Thanks
The .AutoComplete is a function of the Range object - it is based on passing the text to a range that exists elsewhere on the sheet.
You can see the documentation on this function here:
http://msdn.microsoft.com/en-us/library/bb209667(v=office.12).aspx
The myAutoComplete function handles the finding of the autocomplete data against the range if it exists, and the other pieces in the code are for highlighting the correct piece of text.
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