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
Related
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 have developed a custom MsgBox that works fine in almost every way. The only problem is that when the MsgBox closes the parent form runs the Form_Activate code. A normal MsgBox does not run that code (again).
I know i could add a boolean variable to Form_Activate to check if it has fired already, but that's not the best solution when you have a dozen forms.
So, is there a way to not run Form_Activate after closing my custom MsgBox? Does the MsgBox form need to be of some special type or something? I tried all BorderStyles but that doesn't make any difference.
Are you using another form to make custom MsgBox?
You shouldn't use directly other form to show a custom messagebox.
You should create an Activex control, and Activate event won't fire again when the MsgBox is closed.
Within the control you can use a form if you want it. (Probably just have to place your code inside an ActiveX control project and use it in your forms)
I use it that way.
This is a custom MsgBox example using Activex Control, with a test form too.
http://www.codeguru.com/code/legacy/vb_othctrl/2166_CustomMsgBox.zip
I created a Class for a Custom MsgBox.
Public Class CustomMsgBox
'Creates the Main form
Dim Main As New Form
'Creates the buttons
Dim Btn1, Btn2, Btn3 As New Button
'Creates the label
Dim Lbl As New Label
'Creates the Output variable
Dim Output As Integer = 0
Private Sub Load()
'Btn1 properties
Btn1.Location = New Point(168, 69)
Btn1.AutoSize = True
Btn1.AutoSizeMode = AutoSizeMode.GrowOnly
'Btn2 properties
Btn2.Location = New Point(87, 69)
Btn1.AutoSize = True
Btn1.AutoSizeMode = AutoSizeMode.GrowOnly
'Btn3 properties
Btn3.Location = New Point(6, 69)
Btn1.AutoSize = True
Btn1.AutoSizeMode = AutoSizeMode.GrowOnly
'Lbl properties
Lbl.Location = New Point(12, 19)
Lbl.AutoSize = True
Lbl.AutoEllipsis = True
'Main form properties
Main.Size = New Size(211, 129)
Main.AutoSize = True
Main.AutoSizeMode = AutoSizeMode.GrowOnly
Main.ShowIcon = False
Main.Controls.Add(Btn1)
Main.Controls.Add(Btn2)
Main.Controls.Add(Btn3)
Main.Controls.Add(Lbl)
'Adds Handlers to the buttons
AddHandler Btn1.Click, AddressOf btn1_Click
AddHandler Btn2.Click, AddressOf btn2_Click
AddHandler Btn3.Click, AddressOf btn3_Click
End Sub
Function CstMsgBox(ByRef Msg As String, ByRef Title As String, ByRef B1 As String, Optional ByRef B2 As String = Nothing, Optional ByRef B3 As String = Nothing) As Integer
'Runs the Load() Sub
Load()
'Sets the values
Lbl.Text = Msg
Btn1.Text = B1
Btn2.Text = B2
Btn3.Text = B3
Main.Text = Title
'Checks if there is a value set to Btn2 and Btn3
If Btn2.Text = Nothing Then
Btn2.Hide()
End If
If Btn3.Text = Nothing Then
Btn3.Hide()
End If
'Shows the MsgBox
Main.Show()
'Waits until a button is pressed
Do Until Output <> 0
Application.DoEvents()
Loop
'Closes the MsgBox
Main.Close()
Return Output
End Function
Private Sub btn1_Click(ByVal sender As Object, ByVal e As EventArgs)
'Sets the Output value to 1
Output = 1
End Sub
Private Sub btn2_Click(ByVal sender As Object, ByVal e As EventArgs)
'Sets the Output value to 2
Output = 2
End Sub
Private Sub btn3_Click(ByVal sender As Object, ByVal e As EventArgs)
'Sets the Output value to 3
Output = 3
End Sub
End Class
You can use it by typing this:
Dim CMB As New CustomMsgBox
CCMB.CstMsgBox('MSG, 'TITLE, 'BUTTON1, 'Optional: BUTTON2, 'Optional: BUTTON3)
OR
Dim CMB As New CustomMsgBox
Select Case CMB.CstMsgBox('MSG, 'TITLE, 'BUTTON1, 'Optional: BUTTON2, 'Optional: BUTTON3)
Case 1
'Code to execute when button1 is pressed
Case 2
'Code to execute when button2 is pressed
Case 3
'Code to execute when button3 is pressed
End Select
I have a simple form with a drop down box with a list of names in it
and a picture box above that .
how can i make it when i select a name the picture
of that person shows up automatically in the picture box ?
use a user defined type containing both the name as well as the picture file, and then create an array of this type
for example :
'1 form with :
' 1 listbox : name=List1
' 1 picturebox : name=Picture1
Option Explicit
Private Type PERSON
strName As String
strPicture As String
End Type
Private mperFriend(4) As PERSON
Private Sub Form_Load()
Dim intIndex As Integer
mperFriend(0).strName = "Bob"
mperFriend(0).strPicture = "Bob.jpg"
mperFriend(1).strName = "Jane"
mperFriend(1).strPicture = "Jane.jpg"
mperFriend(2).strName = "Fred"
mperFriend(2).strPicture = "Fred.jpg"
mperFriend(3).strName = "Iris"
mperFriend(3).strPicture = "Iris.jpg"
mperFriend(4).strName = "John"
mperFriend(4).strPicture = "John.jpg"
List1.Clear
For intIndex = 0 To UBound(mperFriend)
List1.AddItem mperFriend(intIndex).strName
Next intIndex
End Sub
Private Sub List1_Click()
Caption = mperFriend(List1.ListIndex).strPicture
Picture1.Picture = LoadPicture(App.Path & "\" & mperFriend(List1.ListIndex).strPicture)
End Sub
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 would like to add a Control and an associated event at runtime in Excel using VBA but I don't know how to add the events.
I tried the code below and the Button is correctly created in my userform but the associated click event that should display the hello message is not working.
Any advice/correction would be welcome.
Dim Butn As CommandButton
Set Butn = UserForm1.Controls.Add("Forms.CommandButton.1")
With Butn
.Name = "CommandButton1"
.Caption = "Click me to get the Hello Message"
.Width = 100
.Top = 10
End With
With ThisWorkbook.VBProject.VBComponents("UserForm1.CommandButton1").CodeModule
Line = .CountOfLines
.InsertLines Line + 1, "Sub CommandButton1_Click()"
.InsertLines Line + 2, "MsgBox ""Hello!"""
.InsertLines Line + 3, "End Sub"
End With
UserForm1.Show
The code for adding a button at runtime and then to add events is truly as simple as it is difficult to find out. I can say that because I have spent more time on this perplexity and got irritated more than in anything else I ever programmed.
Create a Userform and put in the following code:
Option Explicit
Dim ButArray() As New Class2
Private Sub UserForm_Initialize()
Dim ctlbut As MSForms.CommandButton
Dim butTop As Long, i As Long
'~~> Decide on the .Top for the 1st TextBox
butTop = 30
For i = 1 To 10
Set ctlbut = Me.Controls.Add("Forms.CommandButton.1", "butTest" & i)
'~~> Define the TextBox .Top and the .Left property here
ctlbut.Top = butTop: ctlbut.Left = 50
ctlbut.Caption = Cells(i, 7).Value
'~~> Increment the .Top for the next TextBox
butTop = butTop + 20
ReDim Preserve ButArray(1 To i)
Set ButArray(i).butEvents = ctlbut
Next
End Sub
Now you need to add a Class Module to your code for the project. Please remember it's class module, not Standard Module.
The Object butEvents is the button that was clicked.
Put in the following simple code (in my case the class name is Class2).
Public WithEvents butEvents As MSForms.CommandButton
Private Sub butEvents_click()
MsgBox "Hi Shrey from " & butEvents.Caption
End Sub
That's it. Now run it!
Try this:
Sub AddButtonAndShow()
Dim Butn As CommandButton
Dim Line As Long
Dim objForm As Object
Set objForm = ThisWorkbook.VBProject.VBComponents("UserForm1")
Set Butn = objForm.Designer.Controls.Add("Forms.CommandButton.1")
With Butn
.Name = "CommandButton1"
.Caption = "Click me to get the Hello Message"
.Width = 100
.Top = 10
End With
With objForm.CodeModule
Line = .CountOfLines
.InsertLines Line + 1, "Sub CommandButton1_Click()"
.InsertLines Line + 2, "MsgBox ""Hello!"""
.InsertLines Line + 3, "End Sub"
End With
VBA.UserForms.Add(objForm.Name).Show
End Sub
This permanently modifies UserForm1 (assuming you save your workbook). If you wanted a temporary userform, then add a new userform instead of setting it to UserForm1. You can then delete the form once you're done with it.
Chip Pearson has some great info about coding the VBE.
DaveShaw, thx for this code man!
I have used it for a togglebutton array (put a 'thumbnail-size' picture called trainer.jpg in the same folder as the excel file for a togglebutton with a picture in it). In the 'click' event the invoker is also available (by the object name as a string)
In the form:
Dim CreateTrainerToggleButtonArray() As New ToggleButtonClass
Private Sub CreateTrainerToggleButton(top As Integer, id As Integer)
Dim pathToPicture As String
pathToPicture = ThisWorkbook.Path & "\trainer.jpg"
Dim idString As String
idString = "TrainerToggleButton" & id
Dim cCont As MSForms.ToggleButton
Set cCont = Me.Controls.Add _
("Forms.ToggleButton.1")
With cCont
.Name = idString
.Width = 20
.Height = 20
.Left = 6
.top = top
.picture = LoadPicture(pathToPicture)
End With
ReDim Preserve CreateTrainerToggleButtonArray(1 To id)
Set CreateTrainerToggleButtonArray(id).ToggleButtonEvents = cCont
CreateTrainerToggleButtonArray(id).ObjectName = idString
End Sub
and a class "ToggleButtonClass"
Public WithEvents ToggleButtonEvents As MSForms.ToggleButton
Public ObjectName As String
Private Sub ToggleButtonEvents_click()
MsgBox "DaveShaw is the man... <3 from your friend: " & ObjectName
End Sub
Now just simple call from UserForm_Initialize
Private Sub UserForm_Initialize()
Dim index As Integer
For index = 1 To 10
Call CreateTrainerToggleButton(100 + (25 * index), index)
Next index
End Sub
This was my solution to add a commandbutton and code without using classes
It adds a reference to allow access to vbide
Adds the button
Then writes a function to handle the click event in the worksheet
Sub AddButton()
Call addref
Set rng = DestSh.Range("B" & x + 3)
'Set btn = DestSh.Buttons.Add(rng.Left, rng.Top, rng.Width, rng.Height)
Set myButton = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Left:=rng.Left, Top:=rng.Top, Height:=rng.Height * 3, Width:=rng.Width * 3)
DoEvents
With myButton
'.Placement = XlPlacement.xlFreeFloating
.Object.Caption = "Export"
.Name = "BtnExport"
.Object.PicturePosition = 1
.Object.Font.Size = 14
End With
Stop
myButton.Object.Picture = LoadPicture("F:\Finalised reports\Templates\Macros\evolution48.bmp")
Call CreateButtonEvent
End Sub
Sub addref()
On Error Resume Next
Application.VBE.ActiveVBProject.References.AddFromFile "C:\Program Files (x86)\Common Files\Microsoft Shared\VBA\VBA6\VBE6EXT.OLB"
Application.VBE.ActiveVBProject.References.AddFromFile "C:\Program Files\Common Files\Microsoft Shared\VBA\VBA6\VBE6EXT.OLB"
End Sub
Private Sub CreateButtonEvent()
On Error GoTo errtrap
Dim oXl As Application: Set oXl = Application
oXl.EnableEvents = False
oXl.DisplayAlerts = False
oXl.ScreenUpdating = False
oXl.VBE.MainWindow.Visible = False
Dim oWs As Worksheet
Dim oVBproj As VBIDE.VBProject
Dim oVBcomp As VBIDE.VBComponent
Dim oVBmod As VBIDE.CodeModule '
Dim lLine As Single
Const QUOTE As String = """"
Set oWs = Sheets("Contingency")
Set oVBproj = ThisWorkbook.VBProject
Set oVBcomp = oVBproj.VBComponents(oWs.CodeName)
Set oVBmod = oVBcomp.CodeModule
With oVBmod
lLine = .CreateEventProc("Click", "BtnExport") + 1
.InsertLines lLine, "Call CSVFile"
End With
oXl.EnableEvents = True
oXl.DisplayAlerts = True
Exit Sub
errtrap:
End Sub
An easy way to do it:
1 - Insert a class module and write this code:
Public WithEvents ChkEvents As MSForms.CommandButton
Private Sub ChkEvents_click()
MsgBox ("Click Event")
End Sub
2 - Insert a userform and write this code:
Dim Chk As New Clase1
Private Sub UserForm_Initialize()
Dim NewCheck As MSForms.CommandButton
Set NewCheck = Me.Controls.Add("Forms.CommandButton.1")
NewCheck.Caption = "Prueba"
Set Chk.ChkEvents = NewCheck
End Sub
Now show the form and click the button
I think the code needs to be added to the Userform, not to the button itself.
So something like
With UserForm1.CodeModule
'Insert code here
End With
In place of your With ThisWorkbook