Access 2016-2019. I have one form with MyTextbox and MyCombobox with one GotFocus event.
When the cursor is on MyTextbox and I click on MyCombobox, I expect a hourglass to appear during the while loop (2 seconds), but the cursor remains as a pointer. Why? Is there any other way to accomplish the same thing?
Private Sub MyCombobox_GotFocus()
DoCmd.Hourglass True ' or Screen.MousePointer = 11
DoEvents
DoCmd.Hourglass True ' or Screen.MousePointer = 11
Debug.Print "A"
Dim i As Long
For i = 1 To 2000000000: Next i ' Do some heavy stuff for about 2 seconds
Debug.Print "B"
DoCmd.Hourglass False
End Sub
Related
My sub Workbook_BeforeClose runs twice, because in my Sub CloseWBFromSharePointFolder, I either check in my file, discard it or cancel and do nothing (see code below). Both the check in and the discarding of the file trigger Workbook_BeforeClose to run again.
Private Sub Workbook_BeforeClose(Cancel As Boolean)
CloseWBFromSharePointFolder
End Sub
Both snippets from CloseWBFromSharePointFolder which trigger Workbook_BeforeClose
Check in
ActiveWorkbook.CheckIn SaveChanges:=True, Comments:="Checked-In by " & Application.Username
Discard
Application.ActiveWorkbook.CheckIn False
Any help would be appreciated.
P.s. I also tried to use a public variable to track if it runs again. This does not work because the public variable got reset. The explanation I found is because Workbook_BeforeClose calls CloseWBFromSharePointFolder, which then triggers Workbook_BeforeClose. This resets everything and the public variable becomes empty
P.s.2 for more details.
CloseWBFromSharePointFolder Code
Sub CloseWBFromSharePointFolder()
Dim myForm1 As UserForm1
Set myForm1 = UserForm1
myForm1.Caption = "Choose before closing:"
myForm1.Show
End Sub
UserForm1 Code
Dim Buttons() As New BtnClass
Private Sub UserForm_Initialize()
Dim ButtonCount As Integer
Dim ctl As Control
' Create the Button objects
ButtonCount = 0
For Each ctl In UserForm1.Controls
If TypeName(ctl) = "CommandButton" Then
'Skip the OKButton
If ctl.Name <> "OKButton" Then
ButtonCount = ButtonCount + 1
ReDim Preserve Buttons(1 To ButtonCount)
Set Buttons(ButtonCount).ButtonGroup = ctl
End If
End If
Next ctl
Me.CommandButton1.Caption = "Check in"
Me.CommandButton2.Caption = "Discard check-out"
Me.CommandButton3.Caption = "Keep checked-out"
Me.CommandButton4.Caption = "Cancel"
End Sub
BtnClass Code
Public WithEvents ButtonGroup As MsForms.CommandButton
Private Sub ButtonGroup_Click()
If UserForm1.Visible = True Then
Select Case ButtonGroup.Name
Case "CommandButton1" 'check in
CheckIn
Case "CommandButton2" 'Discard check-out
Discard
Case "CommandButton3" 'Keep checked-out
KeepCheckedOut
Case Else ' Cancel
'Do Nothing
End Select
Unload UserForm1
ElseIf UserForm2.Visible = True Then
Select Case ButtonGroup.Name
Case "CommandButton1" 'check out
CheckOut
Case "CommandButton2" 'Read only
'Do Nothing
Case Else ' Cancel
'Do Nothing
End Select
Unload UserForm2
End If
End Sub
Sub CheckIn()
If ActiveWorkbook.CanCheckIn = True Then
'Check In, Save and Close
ActiveWorkbook.CheckIn SaveChanges:=True, Comments:="Checked-In by " & Application.Username
MsgBox ("File sucessfully checked in")
Else
MsgBox ("File could not be checked in!")
End If
End Sub
I have a userform (baseUF) that has multiple pages and buttons that all do different things. I have this baseUF being modeless because I want the user to be able to play with the sheet without closing the userform and losing all of the data they input. However, I started having a problem that might be due to the modeless nature of the baseUF.
There are other userforms that can be called from the baseUF. One executes with no issue by double clicking a textbox. However, the other userform is loaded after a button click. Once that button click sub is finished, the baseUF closes after the Exit Sub OR End Sub line. I don't remember this happening in the past and it doesn't happen with any other button click subs.
Does anybody have an idea what the issue could be? I'm pretty lost because I don't have a command to close the baseUF anywhere in that sub. Below is some code to show what is happening:
This sub is connected to a button on the spreadsheet to open the baseUF (the code is in a module).
Sub Button1_Click()
' show the userform
baseUF.Show vbModeless
End Sub
And this is the sub in the baseUF that calls an additional userform (LoadBox) which seems to be the issue.
Private Sub LoadQuery_Click()
' I Dim a bunch of stuff here
' if there are no saved queries, alert the user
If saveSht.Range("B3").Value = "" Then
MsgBox "No saved queries!"
Exit Sub
' if there is only one saved query, add it to the array and pop up the userform that allows for the user to select which save to load
ElseIf saveSht.Range("B4").Value = "" Then
save_names = saveSht.Range("B3").Value
LoadBox.Show
' otherwise, add all of the save names to the array and pop up that userform
Else
save_names = saveSht.Range(saveSht.Range("B3"),saveSht.Range("B3").End(xlDown)).Value
LoadBox.Show
End If
' if the user didn't select a save to load, stop trying to make stuff happen
If load_name = "" Then
' the userform will also close here if this turns out to be true
Exit Sub
End If
' do a bunch of stuff with the selected name here
' and after this line, the userform that contains this code closes
End Sub
EDIT: here is some code showing the two other userforms
This one is the userform with no issue that is called after a textbox is double clicked
Private Sub UserForm_Initialize()
' On start up of this form, populate the listbox with the relevant column names
' Set position
Me.StartUpPosition = 0
Me.Top = baseUF.Top + 0.5 * baseUF.Height - 0.5 * Me.Height
Me.Left = baseUF.Left + 0.5 * baseUF.Width - 0.5 * Me.Width
With FilterSelectionBox
' First grab all of the column names from the main selected table
For i = 0 To baseUF.SelectionBox.ListCount - 1
.AddItem baseUF.SelectionBox.List(i)
Next i
' Then grab all of the column names from the additional tables to be joined
If Not IsVariantEmpty(join_table_cols) Then
For n = 0 To UBound(join_table_cols)
If Not IsEmpty(join_table_cols(n)) Then
For Each col_name In join_table_cols(n)
.AddItem col_name
Next
End If
Next n
End If
End With
End Sub
Private Sub OkButton_Click()
' Initialize the variables
Dim tb As MSForms.TextBox
Dim arr() As String
Dim str As String
' tb is the textbox object that the column names will be pasted in to
Set tb = baseUF.MultiPage1.Pages(baseUF.MultiPage1.Value).Controls(Me.Tag)
' sets the str according to some logic
' This is actually where it gets sent
tb.Value = str
' And close the form
Unload Me
End Sub
And this is the code in the userform with an issue
Private Sub UserForm_Initialize()
' On initialization, populate the combobox with all of the save names present in the spreadsheet
' Set position
Me.StartUpPosition = 0
Me.Top = baseUF.Top + 0.5 * baseUF.Height - 0.5 * Me.Height
Me.Left = baseUF.Left + 0.5 * baseUF.Width - 0.5 * Me.Width
With LoadComb
' If there is more than one save present, go through the array and add each one
If IsArray(save_names) Then
For Each saved_name In save_names
.AddItem saved_name
Next
' Otherwise just add the one
Else
.AddItem save_names
End If
End With
End Sub
Private Sub LoadButton_Click()
' When the user hits the load button, first check if they actually selected anything
If LoadComb.Value = "" Then
' If they didn't, yell at them
MsgBox "No saved query selected!"
Else
' Otherwise, save the name to a global variable
load_name = LoadComb.Value
End If
' Close the form
Unload Me
End Sub
Whenever something unexpected happens with forms, consider writing End in the immediate window and pressing enter. It will kill all the unkilled instances of a form and generally any variable, thus it would be like a cold restart to the VBA program.
After doing this, it is a good idea to consider a cleaner solution, concerning VBA & UserForms, using some OOP. (Disclaimer - the first article is mine):
http://www.vitoshacademy.com/vba-the-perfect-userform-in-vba/
https://rubberduckvba.wordpress.com/2017/10/25/userform1-show/
https://codereview.stackexchange.com/questions/154401/handling-dialog-closure-in-a-vba-user-form
Although it may seem that you are achieving the same results with more code, the benefits of using this approach are quite a lot in the long term.
This is a small example of the OOP model. Imagine you have a user form like this:
It has only the following controls:
btnRun
btnExit
lblInfo
frmMain (the class)
The code withing the form is the following:
Option Explicit
Public Event OnRunReport()
Public Event OnExit()
Public Property Get InformationText() As String
InformationText = lblInfo.Caption
End Property
Public Property Let InformationText(ByVal value As String)
lblInfo.Caption = value
End Property
Public Property Get InformationCaption() As String
InformationCaption = Caption
End Property
Public Property Let InformationCaption(ByVal value As String)
Caption = value
End Property
Private Sub btnRun_Click()
RaiseEvent OnRunReport
End Sub
Private Sub btnExit_Click()
RaiseEvent OnExit
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then
Cancel = True
Hide
End If
End Sub
The form is with two events, getting caught by the clsSummaryPresenter. The clsSummaryPresenter looks like this:
Option Explicit
Private WithEvents objSummaryForm As frmMain
Private Sub Class_Initialize()
Set objSummaryForm = New frmMain
End Sub
Private Sub Class_Terminate()
Set objSummaryForm = Nothing
End Sub
Public Sub Show()
If Not objSummaryForm.Visible Then
objSummaryForm.Show vbModeless
Call ChangeLabelAndCaption("Press Run to Start", "Starting")
End If
With objSummaryForm
.Top = CLng((Application.Height / 2 + Application.Top) - .Height / 2)
.Left = CLng((Application.Width / 2 + Application.Left) - .Width / 2)
End With
End Sub
Private Sub Hide()
If objSummaryForm.Visible Then objSummaryForm.Hide
End Sub
Public Sub ChangeLabelAndCaption(strLabelInfo As String, strCaption As String)
objSummaryForm.InformationText = strLabelInfo
objSummaryForm.InformationCaption = strCaption
objSummaryForm.Repaint
End Sub
Private Sub objSummaryForm_OnRunReport()
MainGenerateReport
Refresh
End Sub
Private Sub objSummaryForm_OnExit()
Hide
End Sub
Public Sub Refresh()
With objSummaryForm
.lblInfo = "Ready"
.Caption = "Task performed"
End With
End Sub
Finally, we have the modMain, which is the so-called business logic of the form:
Option Explicit
Private objPresenter As clsSummaryPresenter
Public Sub MainGenerateReport()
objPresenter.ChangeLabelAndCaption "Starting and running...", "Running..."
GenerateNumbers
End Sub
Public Sub GenerateNumbers()
Dim lngLong As Long
Dim lngLong2 As Long
tblMain.Cells.Clear
For lngLong = 1 To 10
For lngLong2 = 1 To 10
tblMain.Cells(lngLong, lngLong2) = lngLong * lngLong2
Next lngLong2
Next lngLong
End Sub
Public Sub ShowMainForm()
If (objPresenter Is Nothing) Then
Set objPresenter = New clsSummaryPresenter
End If
objPresenter.Show
End Sub
I am trying to make a button visible only if a key (example Control) is press down.
My code:
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 17 Then
Me.btn1.Visible = True
Else
Me.btn1.Visible = False
End If
End Sub
Private Sub Form_Load()
Me.btn1.Visible = False
End Sub
I need to have visible and active the button only when the CONTROL key is press down and the user click on btn1.
Thank you.
Update Code:
Option Compare Database
Option Explicit
Private Sub btnHide_Click()
DoCmd.Close acForm, "frmDemo", acSaveYes
End Sub
Private Sub btnFake_KeyDown(KeyCode As Integer, Shift As Integer)
On Error GoTo Err_Handler
If vbKeyControl = 17 Then
Me.btnHide.Visible = True
FormTimer
Me.btnFake.SetFocus
Me.btnHide.Visible = False
Else
Me.btnHide.Visible = False
End If
Exit_This_Sub:
Exit Sub
Err_Handler:
If Err = 2467 Then '<== Form is closed.
Resume Exit_This_Sub
Else
MsgBox "Error #: " & Err.Number & " " & Err.Description
End If
Resume Exit_This_Sub
End Sub
Private Sub Form_Load()
Me.btnHide.Visible = False
Me.btnFake.SetFocus
End Sub
Sub FormTimer()
Dim PauseTime, Start, Finish, TotalTime
PauseTime = 0.1 ' Set duration.
Start = Timer ' Set start time.
Do While Timer < Start + PauseTime
DoEvents ' Yield to other processes.
Loop
End Sub
I test it and it is working fine. Simple code.
If CONTROL is press btnHide is visible for 0.1sec.
Any ideas?
Say you have aUserForm with TextBox1, TextBox3, TextBox3 and an OK Button.
To only allow the UserForm to close if all three TextBox have data I would use the following script assigned to the OK Button:
Private Sub CommandButton1_Click()
If Len(TextBox1.Value) >= 1 And _
Len(TextBox2.Value) >= 1 And _
Len(TextBox3.Value) >= 1 Then
Me.Hide
Else
MsgBox "Please Complete All Fields!"
End If
End Sub
Is there another way to do this besides an If statement?
Direct User Before Errors Are Made
Preferable to informing a user after an invalid action has been made is to prevent the user from performing that invalid action in the first place[1]. One way to do this is to use the Textbox_AfterUpdate event to call a shared validation routine that controls the Enabled property of your OK button, and also controls the display of a status label. The result is a more informative interface that only allows valid actions, thereby limiting the nuisance of msgbox popups. Here's some example code and screenshots.
Private Sub TextBox1_AfterUpdate()
RunValidation
End Sub
Private Sub TextBox2_AfterUpdate()
RunValidation
End Sub
Private Sub TextBox3_AfterUpdate()
RunValidation
End Sub
Private Sub RunValidation()
If Len(TextBox1.Value) = 0 Or Len(TextBox2.Value) = 0 Or Len(TextBox3.Value) = 0 Then
CommandButton1.Enabled = False
Label1.Visible = True
Else
CommandButton1.Enabled = True
Label1.Visible = False
End If
End Sub
Private Sub CommandButton1_Click()
Me.Hide
End Sub
The If Statement
As far as the If statement is concerned, there are a ton of ways that can be done, but I think anything other than directly evaluating TextBox.Value leads to unnecessary plumbing and code complexity, so I think it's hard to argue for anything other than the If statement in the OP. That being said, this particular If statement can be slightly condensed by capitalizing on its numeric nature, which allows for
Len(TextBox1.Value) = 0 Or Len(TextBox2.Value) = 0 Or Len(TextBox3.Value) = 0
to be replaced with
Len(TextBox1.Value) * Len(TextBox2.Value) * Len(TextBox3.Value) = 0
Although that doesn't gain you much and is arguably less readable code, it does allow for a condensed one liner, especially if the textboxes are renamed...
If Len(TB1.Value) * Len(TB2.Value) * Len(TB3.Value) = 0 Then
.Value vs .Text
Lastly, in this case, I think .Value should be used instead of .Text. .Text is more suited for validating a textbox entry while its being typed, but in this case, you're looking to validate a textbox's saved data, which is what you get from .Value.
More User feedback - Colorization
I almost forgot, I wanted to include this example of how to include even more user feedback. There is a balance between providing useful feedback and overwhelming with too much. This is especially true if the overall form is complicated, or if the intended user has preferences, but color indication for key fields is usually beneficial. A lot of applications may present the form without color at first and then colorize it if the user is having trouble.
Private InvalidColor
Private ValidColor
Private Sub UserForm_Initialize()
InvalidColor = RGB(255, 180, 180)
ValidColor = RGB(180, 255, 180)
TextBox1.BackColor = InvalidColor
TextBox2.BackColor = InvalidColor
TextBox3.BackColor = InvalidColor
End Sub
Private Sub TextBox1_AfterUpdate()
RunValidation Me.ActiveControl
End Sub
Private Sub TextBox2_AfterUpdate()
RunValidation Me.ActiveControl
End Sub
Private Sub TextBox3_AfterUpdate()
RunValidation Me.ActiveControl
End Sub
Private Sub RunValidation(ByRef tb As MSForms.TextBox)
If Len(tb.Value) > 0 Then
tb.BackColor = ValidColor
Else
tb.BackColor = InvalidColor
End If
If Len(TextBox1.Value) * Len(TextBox2.Value) * Len(TextBox3.Value) = 0 Then
CommandButton1.Enabled = False
Label1.Visible = True
Else
CommandButton1.Enabled = True
Label1.Visible = False
End If
End Sub
Private Sub CommandButton1_Click()
Me.Hide
End Sub
As I said in my comment, that is an ok way to do it. But i'll post this just so you have an example of another way. This would allow you to evaluate what is going into the text boxes as they are set.
Option Explicit
Dim bBox1Value As Boolean
Dim bBox2Value As Boolean
Dim bBox3Value As Boolean
Private Sub TextBox1_Change()
If Trim(TextBox1.Text) <> "" Then
bBox1Value = True
End If
End Sub
Private Sub TextBox2_Change()
If Trim(TextBox2.Text) <> "" Then
bBox2Value = True
End If
End Sub
Private Sub TextBox3_Change()
If Trim(TextBox3.Text) <> "" Then
bBox3Value = True
End If
End Sub
Private Sub CommandButton1_Click()
If bBox1Value = True And bBox2Value = True And bBox3Value = True Then
Me.Hide
Else
MsgBox "Please Complete All Fields!"
End If
End Sub
You can use a loop:
Private Sub CommandButton1_Click()
Dim n as long
For n = 1 to 3
If Len(Trim(Me.Controls("TextBox" & n).Value)) = 0 Then
MsgBox "Please Complete All Fields!"
Exit Sub
End If
Next n
Me.Hide
End Sub
You can use the below code
Private Sub CommandButton1_Click()
If Trim(TextBox1.Value & vbNullString) = vbNullString And _
Trim(TextBox2.Value & vbNullString) = vbNullString And _
Trim(TextBox3.Value & vbNullString) = vbNullString Then
Me.Hide
Else
MsgBox "Please Complete All Fields!"
End If
End Sub
I got the answer from this question
VBA to verify if text exists in a textbox, then check if date is in the correct format
I am searching for a better way to disable ActiveX events from triggering in an Excel workbook (though this would apply to all Office apps with ActiveX objects).
Hopefully something similar to Application.EnableEvents = false, though this does not work with ActiveX.
In the below example it's trivial to use a global boolean but I have a lot of event handlers for my ActiveX objects and it would be immensely easier for something I could universally apply to temporarily disable ActiveX events. I don't really want to add an if/exit sub statement to every single one of these methods.
To demonstrate this problem, create an ActiveX combobox in a worksheet and add the following to that sheet module
Public initializingContent As Boolean
Private Sub intializeAllActiveXContent()
'this doesn't apply to activeX events :'(
Application.EnableEvents = False
'this could work but is not really elegant
'change this to false to show my problem in
'the intermediate window (called not once but twice)
initializingContent = True
ComboBoxTest.Clear
ComboBoxTest.AddItem ("item1")
ComboBoxTest.AddItem ("item2")
ComboBoxTest.AddItem ("item3")
'select the top value in the box
ComboBoxTest.value = "item1"
initializingContent = False
Application.EnableEvents = True
End Sub
Private Sub ComboBoxTest_Change()
'I really don't want to have to wrap EVERY single ActiveX method
'with something like this for a whole variety of reasons...
If initializingContent Then Exit Sub
Debug.Print "do stuff I don't want to happen when intializeAllActiveXContent() runs " & _
"but I do when user changes box"
End Sub
I know this is really old. But anyone who looks this up (first hit on google) might want a simple answer:
Lets say you have a Private Sub ActiveXControl_Change() that is getting called during an Application.EnableEvents = False and you want it to skip this just go:
Private Sub ActiveXControl_Change()
If Application.EnableEvents = True Then
'enter you code here
End If
End Sub
Why not disable them? That ways you don't have to worry about their individual codes as well.
Try this
Sub DisableActiveXControls()
Dim ws As Worksheet
Dim OLEobj As OLEObject
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
For Each OLEobj In ws.OLEObjects
If TypeOf OLEobj.Object Is MSForms.ComboBox Then
OLEobj.Enabled = False
End If
Next OLEobj
End With
End Sub
Before/After ScreenShots:
FOLLOWUP FROM COMMENTS:
Also turns out this breaks hard core on objects which are grouped together but I can ungroup objects (they are no longer in "Sheet1.OLEobjects" I guess). I still don't really like this since it relies on this fact and there will be times when I do want to group objects.. – enderland 17 mins ago
To disables ActiveX Controls in a group, you don't need to ungroup them. Use this code. The below code will disable Comboboxes in a group.
Sub Disable_ActiveX_Controls_In_A_Group()
Dim shp As Shape, indvShp As Shape
Dim OLEobj As OLEObject
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Sheet1")
For Each shp In ws.Shapes
If shp.Type = msoGroup Then
For Each indvShp In shp.GroupItems
Set objOLE = indvShp.OLEFormat.Object
If objOLE.progID = "Forms.ComboBox.1" Then _
objOLE.Enabled = False
Next
End If
Next
End Sub
came across this post when searching for a similar issue. I decided the answer posted here would not suit my situation, and came up with something else. My approach may be useful here also.
In my workbook, I have a set of 20 (Activex) checkboxes. These essentially filter on/off 20 categories of product to be included in a report. There is a routine that runs each time one of these checkboxes is changed, simply by calling the routing from the CheckBox_Click routine.
Then I also have a combobox that selects various groups of these checkboxes. The trouble is that when EACH of the 20 checkboxes is (un)selected by the combobox code, the calculation routine is triggered.
What I wanted was to run the calculation routine only ONCE at the end of the combobox, but still have it work if I change an individual checkbox manually.
My solution - put in a TRUE/FALSE code in some cell on a hidden worksheet, somewhere it's out of the way and won't interfere.
Then the CheckBox_Click code becomes (for each of the 20 checkboxes):
Private Sub CheckBox6_Click()
If (Sheets("Data").Range("G60")) Then
Call RangeFind
End If
End Sub
The combobox code modifies this same cell, appropriately:
Private Sub ComboBox28_Change()
Sheets("Data").Range("G60").Value = False
Select Case Sheets("Data").Range("F50").Value
Case "1"
CheckBox1.Value = False
CheckBox2.Value = False
CheckBox3.Value = False
....
End Select
' This turns the checkboxes back on
Sheets("Data").Range("G60").Value = True
' This now actually calls the calculation ONCE
Call RangeFind
ActiveSheet.Range("A1").Activate
End Sub
Cheers,
Michael
Here is one option:
Private Sub ToggleButton1_Click()
If Application.EnableEvents = True Then
'This next line forces at least 1 of the toggle's to be selected at all
'times; remove it from all routines if this is not desired.
If Not ToggleButton1.Value Then ToggleButton1.Value = True
Application.EnableEvents = False
ToggleButton2.Value = False
ToggleButton3.Value = False
Application.EnableEvents = True
End If
End Sub
Private Sub ToggleButton2_Click()
If Application.EnableEvents = True Then
If Not ToggleButton2.Value Then ToggleButton2.Value = True
Application.EnableEvents = False
ToggleButton1.Value = False
ToggleButton3.Value = False
Application.EnableEvents = True
End If
End Sub
Private Sub ToggleButton3_Click()
If Application.EnableEvents = True Then
If Not ToggleButton3.Value Then ToggleButton3.Value = True
Application.EnableEvents = False
ToggleButton1.Value = False
ToggleButton2.Value = False
Application.EnableEvents = True
End If
End Sub