How to send focus to a text box of a VBA form during its initialization/activate event? - vba

I have a VBA form in Corel. Behaving exactly like a similar one in Excel...
Initially, when the form initialize event used to contain only some lines of code, the simple ending line me.txtCsv.Setfocus used to send the focus on it. I mean, it appeared being in edit mode with the cursor blinking inside.
After a period of time, after the application became complex, I am not able to send the focus to the text box in discussion.
I know that Activate event goes last and I also have in it the line me.txtCsv.Setfocus. But without expected result. Inside the Initialization event code I inserted that line Debug.Print Me.ActiveControl.Name & " - 1", changing 1 in 2, 3 up to 6 in many places, including the last line and all the time the name of the text box in discussion (txtCsv) appears in Immediate Window.
So, the control in discussion is the activate one, but the cursor is not inside it when the form is loaded.
TabStop is set to True. I set the TabIndex to 0.
The control is enabled and not blocked. I have created a new simple form with three text boxes and it works well.
I mean the text box which I want to send the focus, has the focus when the form is loaded, keeping a similar code in its Initialize or Activate events.
I compared all properties of the two forms and all text box controls and they are the same...
When I send the focus from another control on the form, the text box in discussion receives it.
It does not receive the focus (anymore) only when the form is shown, the focus being sent by Initialize or Activate evens.
Events code:
Private Sub UserForm_Activate()
Me.txtCsv.SetFocus
End Sub
Private Sub UserForm_Initialize()
Dim P As Printer, i As Long, NrImp As Long, prDefault As String, strJustEngr As String
Dim Printers() As String, n As Long, s As String, boolFound As Boolean
Dim strEng As String, MEngr As Variant, m As Variant, el As Variant, defSize As String
Dim strDropbox As String
boolOpt = True: boolFound = False
Me.cbPrinters.Clear
If Me.chkNewStyle.Value = True Then boolNewStyle = True
prDefault = Application.Printers.Default.Name
strEng = GetSetting(ECA_K, ECA_set, ECA_Engr, "No settings...")
If strEng <> "No settings..." Then
boolSelectedEngravers = True ' only adding engraver is possible...
MEngr = Split(strEng, "|")
'Incarcare in combo:
Me.cbPrinters.Clear
For Each el In MEngr
m = Split(el, ":")
Me.cbPrinters.AddItem m(0)
If m(0) = prDefault Then
boolFound = True
defSize = m(1)
End If
Next
Me.cbPrinters.Value = Me.cbPrinters.List(0)
With Me.btChoosePrinters
.Caption = "Add an Engraver"
.ControlTipText = "Add another Engraver(must be installed)"
End With
Me.btEliminatePrinters.Enabled = True
Me.lblPrinters.Caption = "Engravers: "
Me.cbPrinters.ControlTipText = "Select Engraver to be used!"
Else
Printers = GetPrinterFullNames()
For n = LBound(Printers) To UBound(Printers)
Me.cbPrinters.AddItem Printers(n)
If Printers(n) = prDefault Then boolFound = True
Next n
boolSelectedEngravers = False
End If
Debug.Print Me.ActiveControl.Name & " - 1"
If boolFound Then
Me.cbPrinters.Value = prDefault
Else
Me.lblStatus.Caption = "The default printer (""" & prDefault & """) is not a laser Engraver..."
End If
If GetSetting(ECA_K, ECA_set, "LowRAM", "No settings...") <> "No settings..." Then
boolLowRAM = CBool(GetSetting(ECA_K, ECA_set, "LowRAM", "No settings..."))
End If
If boolLowRAM = True Then
Me.chkLowRAM.Value = True
Else
Me.chkLowRAM.Value = False
End If
Debug.Print Me.ActiveControl.Name & " - 2"
'Direct engrave setting:
Dim strDirectEngrave As String
strDirectEngrave = GetSetting(ECA_K, ECA_set, ECA_Direct_Engrave, "Nothing")
If strDirectEngrave <> "Nothing" Then
Me.chkDirectEngrave.Value = CBool(strDirectEngrave)
If CBool(strDirectEngrave) = True Then
boolDirectEngrave = True
Else
boolDirectEngrave = False
End If
End If
'_______________________________________
strJustEngr = GetSetting(ECA_K, ECA_set, ECA_Just_Engrave, "Nothing")
If strJustEngr <> "Nothing" Then
'Application.EventsEnabled = False
boolChangeEngr = True
Me.chkJustEngrave.Value = CBool(strJustEngr)
boolChangeEngr = False
'Application.EventsEnabled = True
If CBool(strJustEngr) = True Then
Me.chkDirectEngrave.Enabled = True
boolJustEngrave = True
Me.frLocFoldPath.Enabled = True
Else
Me.frLocFoldPath.Enabled = False
Me.chkDirectEngrave.Enabled = False
End If
End If
Debug.Print Me.ActiveControl.Name & " - 3"
If boolSelectedEngravers Then
Application.EventsEnabled = False
Me.btGo.ForeColor = RGB(45, 105, 7)
Me.txtCsv.BackColor = RGB(153, 255, 51)
Me.btGo.Enabled = False
Me.txtCsv.SetFocus
Application.EventsEnabled = True
End If
strDropbox = GetSetting(ECA_K, ECA_set, ECA_Dropbox, "No value")
If strDropbox <> "No value" Then
If CBool(strDropbox) = True Then
Me.chkDropbox.Value = True
End If
End If
AllRefresh
Me.chkCloseDoc.Value = True
Me.txtCsv.SetFocus
Debug.Print Me.ActiveControl.Name & " - 4"
End Sub
Private Sub AllRefresh()
Application.Optimization = False
Application.EventsEnabled = True
If Documents.Count > 0 Then
ActiveWindow.Refresh
ActiveDocument.PreserveSelection = True
End If
Application.Refresh
End Sub
Is there something else, crossing your mind, to be tested?
In the meantime I did some more tests, respectively:
I created a new project (.GMS file) and I imported the form in discussion.I started commenting all the Initialize event code, except the last two code lines.
It didn't set the focus! Commenting everything, letting only the Activate event code, it worked.
I started to un-comment lines in Initialize event code and I found a line not allowing the focus to be sent to that text box.
Setting the value of the combo: Me.cbPrinters.Value = Me.cbPrinters.List(0), moving it in the Activate event code, before the part pointing to txtCSV, worked well.
Now, I tried to do the same in the original form and it does not work...

The above question has been solved by Disabling followed by Enabling of the text box in discussion, but only doing that in Form Activate event. It did not work in Initialize event...
Private Sub UserForm_Activate()
Me.txtCsv.Disable: Me.txtCsv.Enable
Me.txtCsv.SetFocus
End Sub

Related

popup message shown while form closing

I have a database with the following
Mainfrm Form (Main Form - it has popup messages on load event)
kikThemOut Form (Loads hidden with Main Form and every 5 sec it checks for field value on table if it is 1 then call the Function fGetOut())
GetOutMod Module (has fGetOut() Function)
it works all fine, except when application closing it loads the popup alerts from Mainfrm again! which should not load.
Mainfrm Form Code
Private Sub Form_Load()
'to check for T&I notifications
Dim trs As Recordset
Set trs = CurrentDb.OpenRecordset("Y22_CurrMonth")
If trs.EOF = False Then
Dim tMsg, tStyle, tTitle, tHelp, tCtxt, tResponse, tMyString
tMsg = "There are Notifications Due, Do you want to view them?"
tStyle = vbYesNo + vbExclamation + vbDefaultButton2
tTitle = "Notifications Alert"
tHelp = "DEMO.HLP"
tCtxt = 1000
tResponse = MsgBox(tMsg, tStyle, tTitle, tHelp, tCtxt)
If tResponse = vbYes Then ' User chose Yes.
DoCmd.OpenReport "Notifications Current Month", acViewReport, acWindowNormal
Else
tMyString = "No"
End If
End If
'to load the checker form
DoCmd.OpenForm "kikThemOut", , , , , acHidden
End Sub
and this is the GetOutMod Module to force users to exit the db
GetOutMod Module
Option Compare Database
Option Explicit
Function fGetOut() As Integer
Dim RetVal As Integer
Dim db As DAO.Database
Dim rst As Recordset
On Error GoTo Err_fGGO
Set db = DBEngine.Workspaces(0).Databases(0)
Set rst = db.OpenRecordset("KickEmOff", dbOpenSnapshot)
If rst.EOF And rst.BOF Then
RetVal = True
GoTo Exit_fGGO
Else
If DSum("GetOut", "KickEmOff") = "1" Then
Application.Quit
Else
RetVal = True
End If
End If
Exit_fGGO:
fGetOut = RetVal
Exit Function
Err_fGGO:
'Note lack of message box on error
Resume Next
End Function
And this code in the load event of kikThemOut form to check for the same condition, if it is 1 then load this popup message (I could not add popup message to my GetOutMod Module with the function fGetOut)
kikThemOut form Code
Private Sub Form_Timer()
If DSum("GetOut", "KickEmOff") = "1" Then
Set TaskDialogAC = New cTaskDialog
With TaskDialogAC
.Init
.MainInstruction = "Dashboard Maintenance"
.Flags = TDF_CALLBACK_TIMER
.Content = "The Dashboard will be closed after 20 seconds for maintenance"
.CommonButtons = TDCBF_CLOSE_BUTTON
.IconMain = IDI_WINLOGO
.Footer = "Closing in 20 seconds..."
.Title = "Dashboard Maintenance"
.AutocloseTime = 20 'seconds
.ParenthWnd = Me.hwnd
.ShowDialog
End With
Call fGetOut
Else
If DSum("GetOut", "KickEmOff") = "0" Then
DoCmd.Requery
End If
End If
End Sub
Really hard to read your code and figure out where your function is being called from.
But I'm assuming this should work for you as described
Add this before your fGetOut function
Public blClosing as Boolean
And then add this inside your function at the top (after On Error GoTo Err_fGGO)
if blClosing then
blClosing = False
Exit function
Else
blClosing = True
End if

Can someone help me with the validation of a checkbox in an Access form?

I have problems with the validation of an Access form, and more precisely with a checkbox, since Access tells me that the object does not support that property or that method.
My code to carry out the verification, evaluates each control of the form, and if its value is empty or null, it paints the background color of it orange, and if it is corrected, it returns it to white.
Since the checkbox object does not share the BackColor property with the textbox or combobox, I tried to use BorderColor, which is common to all three.
My code:
Private Sub ValidarCampos()
Dim FormActivo As Form
Dim control As control
Set FormActivo = Forms(0)
ValidaCampos = True
For Each control In FormActivo.Controls
If (control.ControlType = 109 Or control.ControlType = 111 Or control.ControlType = 106) And control.Visible = True And control.Enabled = True Then 'Revisar el 106 (checkbox)
If control.ControlType = 106 Then
valor = control.TripleState
Else
valor = Trim(control.Value)
End If
Debug.Print valor
'If (valor = "" Or IsNull(valor)) And control.Tag = "*" Then
If (valor = "" Or IsNull(valor)) Then
control.BorderColor = VBA.RGB(237, 125, 49)
'MsgBox "No puede dejar nulo el campo " & control.Name, vbInformation, tiTulo
If FormActivo.Controls(control.Name).Enabled = True Then
FormActivo.Controls(control.Name).SetFocus
End If
ValidaCampos = False
'Exit Function
Exit Sub
Else
control.BackColor = VBA.vbWhite
End If
End If
Next
End Sub
Clarification:
The problem occurs with the "Enabled" property of the checkbox
When it evaluates to the checkbox, Access tells me that the object does not support that property or method.
I've had trouble with the access checkbox not working properly twice before. You can get around the checkbox by turning a label into a synthetic checkbox. This also gets you the back color property. I got the outline of the solution from Fred here: http://www.justskins.com/forums/changing-check-box-colour-171415.html
put a label and a checkbox on a form. set the checkbox visible property to false. resize the label and set the label.border property to solid to make the label look like a checkbox. Set the label font to wingdings. then here is the code.
'in form codebehind
Private Sub labelthatlookslikeacheckbox_Click()
If Me.invisiblecheckbox.Value = -1 Then
Me.invisiblecheckbox.Value = 0
Me.labelthatlookslikeacheckbox.Caption = ""
Else
If IsNull(Me.invisiblecheckbox.Value) Then
Me.invisiblecheckbox.Value = -1
Me.labelthatlookslikeacheckbox.Caption = Chr(254)
Else
Me.invisiblecheckbox.Value = Null
Me.labelthatlookslikeacheckbox.Caption = Chr(110)
End If
End If
Me.Refresh 'update display
End Sub
'in a module
Private Sub ValidarCampos()
Dim FormActivo As Form
Dim control As control
Set FormActivo = Forms(0)
ValidaCampos = True
For Each control In FormActivo.Controls
If (control.ControlType = acCheckBox) Then
If (control.Name = "invisiblecheckbox") And IsNull(control.Value) Then
FormActivo.Controls("labelthatlookslikeacheckbox").BackColor = VBA.RGB(237, 125, 49)
Else
FormActivo.Controls("labelthatlookslikeacheckbox").BackColor = vbWhite
End If
'HANDLE OTHER CHECKBOXES HERE
'if going generic one solution is to use a checkbox and label naming convention then parse control.name
Else
If (control.ControlType = acTextBox Or control.ControlType = acComboBox) Then
'labels don't have an enabled control so we only test textboxes and comboboxes
If control.Visible = True And control.Enabled = True Then
valor = Trim(control.Value)
Debug.Print valor
If (valor = "" Or IsNull(valor)) Then
control.BackColor = VBA.RGB(237, 125, 49)
If FormActivo.Controls(control.Name).Enabled = True Then
FormActivo.Controls(control.Name).SetFocus
End If
ValidaCampos = False
Else
control.BackColor = VBA.vbWhite
End If
End If
End If
End If
Next 'control
End Sub
Top checkbox is the label:
Without Text highlighted :

How can I make labels invisible on load in Access 2007

I've got a logger form which hides the text and combo boxes until you hit the "start activity" but is there anyway I can also make the labels disappear on load also and then also appear once a start button is pressed?
Here is a sample of my code:
Private Sub Form_Load()
strUserID = Environ("USERNAME")
AppVersion = "Version - " & DLookup("Version", "Version", "ID = 1") & " - " & DLookup("VersionDate", "Version", "ID = 1")
Me.txtVersion = AppVersion
Me.cmdStartCall.Visible = True
Me.txtPolicyClaimReference.Visible = False
Me.txtJobReference.Visible = False
Me.txtNotes.Visible = False
Me.CboContactMethod.Visible = False
Me.CboTitle.Visible = False
Me.CboDepartment.Visible = False
Me.CboLocation.Visible = False
Me.txtScheme.Visible = False
Me.txtFirstName.Visible = False
Me.txtSurname.Visible = False
End Sub
So if we assume that each txt or cbo box has the same name label, how can i get them not to show unless activated?
Thanks
Dan
The labels must be attached (associated) to their textboxes/comboboxes, then they are hidden automatically with them.
To attach separated labels:
Select the label
Issue the Cut command
Select the control to which you want to attach the label
Issue the Paste command.
(from http://www.consultdmw.com/access-control-labels.htm)

How to create expandable/retractable form MS Access 2013 VBA?

I am creating a data entry form for one of my database tables. For one of the sections, I have the text field with ONLY the caption: "Description 1" showing. If the Description 1 textbox is filled out by the user, I want it to show the Description 2 textbox. If the user fills out the Description 2 textbox, the Description 3 textbox will show up and so on up to 10 Description textboxes. Is there a way to hide the extra text boxes kind of like when you fill out the information while creating a macro? For example when you click Create --> Macro, there is only a dropdown box for you to select an action. If you choose Open Form and hit enter, 6 more text boxes with captions appear.
Is there a way to get that kind of functionality in a form? Also, in the Macro builder, it dynamically rearranges the page for you, can this also be done with the form?
Follow these steps:
Mark the visible property as false
Add OnChange event for each textbox.
Write the VBA code to determine if the next control will be showed or hide. Note, the Me!FormControlItem.Text is accessible only if the control is focused.
There is the 3 functions for each control.
Private Sub text1_Change()
If Not Trim(Me!text1.Text) = "" Then
Me!Text2.Visible = True
Me!Label2.Visible = True
ElseIf Not Trim(Me!Text2) = "" Then
Me!Text2.Visible = True
Me!Label2.Visible = True
Else
Me!Text2.Visible = False
Me!Label2.Visible = False
End If
End Sub
Private Sub Text2_Change()
If Not Trim(Me!Text2.Text) = "" Then
Me!Text3.Visible = True
Me!Label3.Visible = True
ElseIf Not Trim(Me!Text3) = "" Then
Me!Text3.Visible = True
Me!Label3.Visible = True
Else
Me!Text3.Visible = False
Me!Label3.Visible = False
End If
End Sub
Private Sub Text3_Change()
If Not Trim(Me!Text3.Text) = "" Then
Me!Text4.Visible = True
Me!Label4.Visible = True
ElseIf Not Trim(Me!Text4) = "" Then
Me!Text4.Visible = True
Me!Label4.Visible = True
Else
Me!Text4.Visible = False
Me!Label4.Visible = False
End If
End Sub
Enjoy!

ActiveX List Boxes will not "Size and Move" with their parent cells

I'm new at VBA so sorry in advance if this is a silly question. I have a Worksheet with ActiveX List boxes. The worksheet also has Toggle Switches. The toggle switches are set up to Hide Rows and ActiveX boxes when not depressed and Show Rows and ActiveX boxes when depressed. I'd like to save the file with all of the Toggle switches not depressed so that the user can un-hide only the rows and boxes that they need. Everything works properly until I save the file with all rows hidden. After the save all of the boxes change locations. I've tried setting the boxes to "Move and Size with cell", "Move but don't size with cell", and "Don't more or Size with cell" in the preferences. The same thing happens with all options. Below is my toggle switch code. Is there something in there causing this to happen?
Private Sub ToggleButton1_Click()
If ToggleButton1.Value = True Then
'This area contains the things you want to happen
'when the toggle button is not depressed
Range("101:183").EntireRow.Hidden = False
Sheet1.Range("94:144").EntireRow.Hidden = False
'This hides the listboxes since they can not move and
'size with cells
Sheet11.OLEObjects("ListBox1").Visible = True
Sheet11.OLEObjects("ListBox2").Visible = True
Sheet11.OLEObjects("ListBox3").Visible = True
Sheet11.OLEObjects("ListBox4").Visible = True
Sheet11.OLEObjects("ListBox5").Visible = True
Sheet11.OLEObjects("ListBox6").Visible = True
Sheet11.OLEObjects("ListBox7").Visible = True
Sheet11.OLEObjects("ListBox8").Visible = True
Sheet11.OLEObjects("ListBox9").Visible = True
Sheet11.OLEObjects("ListBox10").Visible = True
Sheet11.OLEObjects("ListBox11").Visible = True
Sheet11.OLEObjects("ListBox12").Visible = True
Sheet11.OLEObjects("ListBox13").Visible = True
Sheet11.OLEObjects("ListBox14").Visible = True
Sheet11.OLEObjects("ListBox15").Visible = True
Sheet11.OLEObjects("ListBox16").Visible = True
Sheet11.OLEObjects("ListBox17").Visible = True
Sheet11.OLEObjects("ListBox18").Visible = True
Else
'This area contains the things you want to happen
'when the toggle button is depressed
Range("101:183").EntireRow.Hidden = True
Sheet1.Range("94:144").EntireRow.Hidden = True
Sheet11.OLEObjects("ListBox1").Visible = False
Sheet11.OLEObjects("ListBox2").Visible = False
Sheet11.OLEObjects("ListBox3").Visible = False
Sheet11.OLEObjects("ListBox4").Visible = False
Sheet11.OLEObjects("ListBox5").Visible = False
Sheet11.OLEObjects("ListBox6").Visible = False
Sheet11.OLEObjects("ListBox7").Visible = False
Sheet11.OLEObjects("ListBox8").Visible = False
Sheet11.OLEObjects("ListBox9").Visible = False
Sheet11.OLEObjects("ListBox10").Visible = False
Sheet11.OLEObjects("ListBox11").Visible = False
Sheet11.OLEObjects("ListBox12").Visible = False
Sheet11.OLEObjects("ListBox13").Visible = False
Sheet11.OLEObjects("ListBox14").Visible = False
Sheet11.OLEObjects("ListBox15").Visible = False
Sheet11.OLEObjects("ListBox16").Visible = False
Sheet11.OLEObjects("ListBox17").Visible = False
Sheet11.OLEObjects("ListBox18").Visible = False
End If
End Sub
I know this isn't the answer to your question (I haven't even looked at it yet), but i just felt like giving you this code, this is the exact code you provided and will function the same way, just looks a tiny bit clearer (actually as it also removes the if statement it prolly even performs at like 1/1000000 of a millisecond faster also =D)
Private Sub ToggleButton1_Click()
Dim boolToggleValue As Boolean
Dim i As Integer
boolToggleValue = ToggleButton1.Value
'This area contains the things you want to happen
'when the toggle button is not depressed
Range("101:183").EntireRow.Hidden = Not boolToggleValue
Sheet1.Range("94:144").EntireRow.Hidden = Not boolToggleValue
'This hides the listboxes since they can not move and
'size with cells
With Sheet11
For i = 1 To 18
.OLEObjects("ListBox" & i).Visible = boolToggleValue
Next i
End With
End Sub