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?
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 am trying to create a macro that can automatically close the workbook within 5 minutes plus there will be a pop up reminder message at 4 mins 30 sec. I want the message box to be automatically closed in 10 seconds if user does not click the ok button. I am stuck at the point that the message box cannot close within 10 seconds. Most of my code are copied from the internet. Below are my codes:
In the workbook page:
Private Sub workbook_open()
Call settimer
End Sub
Private Sub workbook_beforeclose(cancel As Boolean)
Call stoptimer
End Sub
Private Sub workbook_sheetcalculate(ByVal sh As Object)
Call stoptimer
Call settimer
End Sub
Private Sub workbook_sheetselectionchange(ByVal sh As Object, _
ByVal target As Excel.Range)
Call stoptimer
Call settimer
End Sub
In the module
Dim downtime As Date
Sub settimer()
downtime = Now + TimeValue("00:01:00")
alerttime = downtime - TimeValue("00:00:50")
Application.OnTime Earliesttime:=alerttime, _
procedure:="alertuser", schedule:=True
Application.OnTime Earliesttime:=Downtime, _
procedure:="shutdown", schedule:=True
End Sub
Sub stoptimer()
On Error Resume Next
Application.OnTime Earliesttime:=downtime, _
procedure:="shutdown", schedule:=False
End Sub
Sub shutdown()
Application.DisplayAlerts = True
With ThisWorkbook
.Save = True
.Close
End With
End Sub
Sub alertuser()
Dim wsshell
Dim intText As Integer
Set wsshell = CreateObject("WScript.Shell")
intText = wsshell.Popup("log sheet will be closed in 30 seconds if there are no more inputs", 10, "reminder")
Set wsshell = Nothing
End Sub
You need to fully qualify your procedure name. It is not finding the procedure in question. You also had a typo and where missing the global variable alerttime. Try this:
Public downtime As Date
Public alerttime As Date
Private Sub workbook_open()
Call settimer
End Sub
Private Sub workbook_beforeclose(cancel As Boolean)
Call stoptimer
End Sub
Private Sub workbook_sheetcalculate(ByVal sh As Object)
Call stoptimer
Call settimer
End Sub
Private Sub workbook_sheetselectionchange(ByVal sh As Object, _
ByVal target As Excel.Range)
Call stoptimer
Call settimer
End Sub
Sub settimer()
downtime = Now + TimeValue("00:01:00")
alerttime = downtime - TimeValue("00:00:50")
'fully qualify your procedure name here and the procedure will run
Application.OnTime Earliesttime:=alerttime, _
procedure:="WorkbookName.xlsm!ThisWorkbook.alertuser", schedule:=True
'and here... also typo was here in downtime
Application.OnTime Earliesttime:=downtime, _
procedure:="WorkbookName.xlsm!ThisWorkbook.shutdown", schedule:=True
End Sub
Sub stoptimer()
On Error Resume Next
Application.OnTime Earliesttime:=downtime, _
procedure:="shutdown", schedule:=False
End Sub
Sub shutdown()
Application.DisplayAlerts = True
With ThisWorkbook
.Save = True
.Close
End With
End Sub
Sub alertuser()
Dim wsshell
Dim intText As Integer
Set wsshell = CreateObject("WScript.Shell")
intText = wsshell.Popup("log sheet will be closed in 30 seconds if there are no more inputs", 10, "reminder")
Set wsshell = Nothing
End Sub
You could use a userform (which you Insert into your project in the VBA editor) which looks something like this:
In the properties window I changed the forms name to formReminder to make it easier to refer to in other modules. Then, in the userform's code window I put:
Private Running As Boolean
Private Sub CommandButton1_Click()
Running = False
End Sub
Private Sub UserForm_Activate()
Dim start As Single
start = Timer
Running = True
Do While Running And Timer < start + 10
DoEvents
Loop
Unload Me
End Sub
Private Sub UserForm_Click()
Running = False
End Sub
When you run the line formReminder.Show anywhere else in the code (e.g. -- in place of where you create the popup) the form will display and show for 10 seconds (or less if you click anywhere on it) and then disappear.
While it displays it will look like this:
Thanks, John Coleman for your answer. It led me to a solution I've wanted for a long time. I took your code and converted it into a generic function that accepts parameters for the message and the number of seconds to wait.
Sub MsgBoxTimerTest()
' Test the Message box with a timer form
Dim vReturn As Variant
vReturn = MsgBoxTimerCall("MessageBox that Dissappears after n Seconds", "Hello World!", 3)
End Sub
' **************************************************************************
Function MsgBoxTimerCall(strCaption As String, strMessage As String, intSeconds As Integer)
' Show a messagebox for a while
' https://stackoverflow.com/questions/37281840/automatic-close-excel-workbook-with-a-pop-up-message
' 2016-06-21
TimerSeconds = intSeconds
msgBoxTimerForm.Caption = strCaption
msgBoxTimerForm.TextBox1.Value = strMessage
msgBoxTimerForm.Show
End Function
' **************************************************************************
' **************************************************************************
Insert this code in the form
' **************************************************************************
Private Running As Boolean
Private Sub CommandButton1_Click()
MsgBox "Yo!"
Running = False
End Sub
Private Sub UserForm_Activate()
Dim start As Single
start = Timer
Running = True
Do While Running And Timer < start + TimerSeconds
DoEvents
Loop
Unload Me
End Sub
Private Sub UserForm_Click()
Running = False
End Sub
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
Using: Access 2013 with ADO connection to SQL Server back-end database
A form in my Access database is dynamically bound at runtime to the results of a SELECT stored-procedure from SQL Server, and allows the user to make changes to the record.
It has 2 buttons: Save and Cancel.
It is shown as a pop-up, modal, dialog form, and it has a (Windows) Close button at the top right corner.
I've put VBA code to ask the user whether he wants to Save, Ignore or Cancel the close action.
But there are problems and it gives the aforementioned error if Cancel is clicked. There are also other problems, like, after the error occurs once, then any further commands (Save or Cancel or closing the form) don't work - I think this is because the VBA interpreter has halted due to the earlier error. Another complication is that arises - I now need to end the MS-Access process from Windows Task Manager, doing this and then restarting the database and then opening this form will give an error and the form won't load. When the form is then opened in Design mode, I can see the connection string for the form is saved in the Form's Record Source property (this happens only sometimes), and which looks something like this:
{ ? = call dbo.tbBeneficiary_S(?) }.
Here is my code:
Dim CancelCloseFlag As Boolean
Dim SavePrompt As Boolean
Private Sub Form_BeforeUpdate(Cancel As Integer)
Dim a As Integer
If SavePrompt Then
a = MsgBox("Do you want to save changes?", vbQuestion + vbYesNoCancel, "Changes made")
Select Case a
Case vbNo:
Me.Undo
CancelCloseFlag = False
Case vbYes:
'do nothing; it will save the changes
CancelCloseFlag = False
Case vbCancel:
Cancel = True
CancelCloseFlag = True
End Select
End If
End Sub
Private Sub Form_Dirty(Cancel As Integer)
SavePrompt = True
End Sub
Private Sub Form_Error(DataErr As Integer, Response As Integer)
If DataErr = 2169 Then
Response = acDataErrContinue
End If
End Sub
Private Sub Form_Load()
LoadBeneficiaryDetails
End Sub
Private Sub Form_Unload(Cancel As Integer)
If CancelCloseFlag Then
Cancel = True
End If
End Sub
Private Sub btCancel_Click()
If Me.Dirty Then
SavePrompt = True
End If
DoCmd.Close
End Sub
Private Sub btSave_Click()
SavePrompt = False
DoCmd.Close
End Sub
I'm stuck and would like to know how others go about this issue? Basically I want to offer the user the choice Save, Ignore, Cancel when the user attempts to close the form with either Cancel button or the (Windows) close button. If the user chooses Cancel, then it should just return to the form without changing or undoing any changes to the data. The solution may be simple but it escapes my overworked mind.
Thanks in advance!
Please try the following code - I tested against all six scenarios and the proper action is taken.
Option Compare Database
Option Explicit
Dim blnAction As Integer
Dim blnBeenThereDoneThat As Boolean
Private Sub Form_BeforeUpdate(Cancel As Integer)
If blnBeenThereDoneThat = True Then Exit Sub
blnBeenThereDoneThat = True
blnAction = MsgBox("Do you want to save changes?", vbQuestion + vbYesNoCancel, "Changes made")
Select Case blnAction
Case vbNo:
Me.Undo
Case vbYes:
'do nothing; it will save the changes
Case vbCancel:
Cancel = True
End Select
End Sub
Private Sub Form_Error(DataErr As Integer, Response As Integer)
If DataErr = 2169 Then
Response = acDataErrContinue
End If
End Sub
Private Sub Form_Load()
LoadBeneficiaryDetails
End Sub
Private Sub Form_Unload(Cancel As Integer)
If blnAction = vbCancel Then
blnBeenThereDoneThat = False
Cancel = True
End If
End Sub
Private Sub btCancel_Click()
If Me.Dirty Then
Form_BeforeUpdate (0)
End If
If blnAction = vbCancel Then
blnBeenThereDoneThat = False
Exit Sub
ElseIf blnAction = vbYes Then
DoCmd.Close
Else
DoCmd.Close
End If
End Sub
Private Sub btSave_Click()
If Me.Dirty Then
Form_BeforeUpdate (0)
End If
If blnAction = vbCancel Then
Exit Sub
Else
DoCmd.Close
End If
End Sub
I'm writing a big macro for MS Word 2013 and one of the parts of it should be sub that prevents user from writing text; user should be able to use hotkey (eg. ctrl+q) to stop (or start) this sub (I already know how to assign a hotkey to a sub). I'm pretty new to VBA. I've googled for the answer but there's only instruction how to write such macro for Excel, but it doesn't work in Word. Is there a way to do this? How?
Thank you in advance.
Dim startTime As Single
Dim stopTime As Single
Dim timeToRun
Dim totalTime
Dim tmpTime
Dim avg As Long
Public isStart As Boolean
Public Sub hotkeyPressed() 'I wrote module to handle this'
If isStart = True Then
stopButton_Click
Else
startButton_Click
End If
End Sub
Private Sub startButton_Click()
totalTime = tmpTime
startTime = Timer
isStart = True
startButton.Enabled = False
stopButton.Enabled = True
ActiveDocument.Protect _
Type:=wdNoProtection
End Sub
Private Sub stopButton_Click()
isStart = False
stopTime = Timer
tmpTime = totalTime + tmpTime
startButton.Enabled = True
stopButton.Enabled = False
ActiveDocument.Protect _
Type:=wdAllowOnlyReading
End Sub
Private Sub Document_New()
startButton.Caption = "Start!"
stopButton.Caption = "Stop"
isStart = False
Call scheduler
ActiveDocument.Protect _
Type:=wdAllowOnlyReading
On Error GoTo Handler:
Open "KM\" + ActiveDocument.Name + ".txt" For Input As #1
Input #1, line
tmpTime = line
Close #1
Exit Sub
Handler:
tmpTime = 0
End Sub
Private Sub Document_Close()
MyFile1 = "KM\" + ActiveDocument.Name + ".txt"
fnum = FreeFile()
Open MyFile1 For Output As fnum
Print #fnum, totalTime
Close fnum
End Sub
Private Sub scheduler()
timeToRun = Now + TimeValue("00:00:01")
Application.OnTime timeToRun, "getNumberOfLetters"
End Sub
Sub getNumberOfLetters()
If isStart = True Then
numOfLetters = ActiveDocument.Characters.Count
totalTime = Timer - startTime
timeLabel.Caption = totalTime + tmpTime
charLabel.Caption = numOfLetters
setResult
End If
Call scheduler
End Sub
Private Sub setResult()
avg = 60 * numOfLetters / czasLabel.Caption
avg.Caption = avg
End Sub
Have you tried simply using the .Protect method?
Sub ProtectDocument()
ActiveDocument.Protect _
Type:=wdAllowOnlyReading
End Sub
This will prevent user input. You can unprotect the document using VBA if necessary:
Sub UnprotectDocument()
ActiveDocument.Protect _
Type:=wdNoProtection
End Sub