Is there any way to keep Doing something while a key (mouse key) is kept pressed in vba?
%' As if there were for example a MouseLeftClicked vba function
Do While MouseLeftClicked
Sheet1.Shapes("Picture 1").Rotation = Sheet1.Shapes("Picture 1").Rotation + 15
DoEvents
The short answer is yes, but you'll need to capture the mouse clicks in a UserForm as below:
In your UserForm
Private Sub UserForm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
booKeyPressed = True
RotateIt
End Sub
Private Sub UserForm_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
booKeyPressed = False
End Sub
In a Module
Public booKeyPressed As Boolean
Function RotateIt()
If Not booKeyPressed Then Exit Function
Application.OnTime Now + TimeValue("00:00:01"), "RotateIt"
Sheet1.Shapes("Picture 1").Rotation = Sheet1.Shapes("Picture 1").Rotation + 15
DoEvents
End Function
The above code will rotate your picture every 1 second so long as the mouse is clicked on your Userform. You can change this to be a specific control and you can also change the time interval should you need to.
There's no way I know of to capture the MouseClick event on a worksheet, but you could link it to a worksheet event if that better suits your needs.
Your question mentions key press, but your sample code mentions mouse. You can easily adapt to which ever you need because both are available as Userform events
Related
I am trying to get a tooltip to display over an ActiveX Checkbox on my excel spreadsheet.
The below code does display and hide the tooltip but not as expected. If you move the mouse over the checkbox too quickly, the tooltip (label) will remain on the sheet.
Private Sub chkPrice_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
With sht
If .lblTooltip.Visible = False Then
.lblTooltip.Visible = True
ElseIf .lblTooltip.Visible = True Then
.lblTooltip.Visible = False
End If
End With
To make the above code work, if there is something along the lines of:
If mousehovers for 1 second Then display the tooltip
Is there a way to check for amount of time the mouse remains on a control?
Is there another way to do this?
There is something pretty tricky that you could do for that, so below you can find a starting point for your specific answer.
Direct answer to the question
On top of your module, you declare the Microsoft API getting the mouse coordinates:
Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Note: if you're using a 32-bit system, remove the PtrSafe keyword from the declaration.
Also, on top of the module, you add this type:
Type POINTAPI
Xcoord As Long
Ycoord As Long
End Type
Hence, inside your macro chkPrice_MouseMove, you do something like this:
When the macro is triggered, get the mouse coordinates
Wait very shortly, say half second
Hence, get again the mouse coordinates. If they are the same than before, it means the user is keeping the mouse on the same point so you can trigger the event.
In code:
Private Sub chkPrice_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Dim llCoordBefore As POINTAPI
Dim llCoordAfter As POINTAPI
GetCursorPos llCoordBefore '<-- get first time
Application.Wait TimeSerial(Hour(Now()), Minute(Now()), Second(Now())+0.5)
GetCursorPos llCoordAfter '<-- get second time
If llCoordBefore.Xcoord = llCoordAfter.Xcoord And llCordBefore.Ycoord = llCoordAfter.Ycoord Then '<-- compare
With sht
If .lblTooltip.Visible = False Then
.lblTooltip.Visible = True
ElseIf .lblTooltip.Visible = True Then
.lblTooltip.Visible = False
End If
End With
End If
Why I wouldn't use this
I think that your best shot is to put the ActiveX control in a place where the user doesn't hover by mistake.
Your code, on mouse hover, says that:
1) If the tooltip is not visible, then make it visible
2) If the tooltip is visible, then hide it
If the user passes quickly on the control, and the tooltip is hidden, it's expected that it will show up and don't hide. The user should pass back on the control to get it hidden again.
In any case, here are some reasons why the above method you thought about is not my recommendation:
The application will wait for X seconds. If the user hovers by mistake, he will get his Excel waiting for X seconds before he can take control again. It might be annoying in terms of UX.
The API gets the coordinates in a very sensitive way. You will need to implement an approximation (in my example, I'm proceeding only if the coordinates are exactly the same before and after hover; however, in real life, you will need to leave some margin cause the mouse might slightly move between the first and the second get of the coordinates).
Use the Application.OnTime to hide the label 1 second after the mouse moves over the checkbox.
Public Code Module
Public TootTipVisible As Boolean
Public CheckBoxHasFocus As Boolean
Public Sub ShowTootTip()
Application.Caption = Now 'TootTipVisible & "," & CheckBoxHasFocus
If Not TootTipVisible And Not CheckBoxHasFocus Then
TootTipVisible = True
Sheet1.sht.Visible = True
Application.OnTime Now + TimeValue("00:00:01"), "HideTootTip"
End If
End Sub
Public Sub HideTootTip()
TootTipVisible = False
Sheet1.sht.Visible = False
End Sub
Worksheet Code Mode
Private Sub chkPrice_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If X > 0 And X < chkPrice.Top - chkPrice.Height Then
ShowTootTip
CheckBoxHasFocus = True
Else
CheckBoxHasFocus = False
End If
End Sub
I've built a form in Excel. It consists of 3 command buttons and a frame containing checkboxes. The checkboxes are dynamically populated at userform_initialize based on tables in an excel sheet (the idea being easy user customization). The reason for the frame is that there can be a lot of checkboxes and I want the user to be able to scroll through them.
My goal now is to create keyboard shortcuts for the form. Where I get stuck is that I can't brute force write KeyDown handlers for each of the checkboxes because I don't know which ones will exist. I realize that it would also just be better if I could have the event handler at the form level. Googling has found me the form's KeyPreview property. Unfortunately, the properties window in VBA IDE doesn't show it and when I try to access it programmatically by setting Me.KeyPreview = True at userform_initialize VBA throws a compile error: "Method or data member not found" - what I would expect given it isn't in the properties window, but was worth a try.
I feel like there's something I'm obviously missing so I thought I'd ask before spending time learning how to write and then rewriting the form entirely as a class as in the MSDN example code:
https://msdn.microsoft.com/en-us/library/system.windows.forms.form.keypreview(v=vs.110).aspx.
Am I that lucky?
I confess to being at the limit of my VBA knowledge and I'm looking to go expand on it. Any general concepts or context I should red would be greatly appreciated.
UPDATE
I'm now thinking about GetAsyncKeyState and Application.Onkey.
From what I understand, GetAsyncKeyState only works within an infinite DoEvents loop. I tried initiating one hoping the form would still load but of course it didn’t – I’m stuck in the loop.
The problem with Application.Onkey is that I can't assign the event function to the key within the userform module. This puzzles me because other event handlers can go in the userform module. In fact, I’d put it in the Userform_Initialize procedure. Is it because it's not a form event but an application event?
EDIT
I seem to have something that works, but for the strange issue described here:
Event handling class will not fire unless I use a breakpoint when initializing form
Thank you #UGP
Here is an example how it could work, found here:
To put in a class named "KeyPreview":
Option Explicit
Dim WithEvents u As MSForms.UserForm
Dim WithEvents t As MSForms.TextBox
Dim WithEvents ob As MSForms.OptionButton
Dim WithEvents lb As MSForms.ListBox
Dim WithEvents dp As MSComCtl2.DTPicker
Event KeyDown(ByVal KeyCode As Integer, ByVal Shift As Integer)
'Event KeyPress(ByVal KeyAscii As Integer)
Private FireOnThisKeyCode As Integer
Friend Sub AddToPreview(Parent As UserForm, KeyCode As Integer)
Dim c As Control
Set u = Parent
FireOnThisKeyCode = KeyCode
For Each c In Parent.Controls
Select Case TypeName(c)
Case "TextBox"
Set t = c
Case "OptionButton"
Set ob = c
Case "ListBox"
Set lb = c
Case "DTPicker"
Set dp = c
End Select
Next c
End Sub
Private Sub u_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = FireOnThisKeyCode Then RaiseEvent KeyDown(KeyCode, Shift)
End Sub
Private Sub t_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = FireOnThisKeyCode Then RaiseEvent KeyDown(KeyCode, Shift)
End Sub
Private Sub ob_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = FireOnThisKeyCode Then RaiseEvent KeyDown(KeyCode, Shift)
End Sub
Private Sub lb_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = FireOnThisKeyCode Then RaiseEvent KeyDown(KeyCode, Shift)
End Sub
Private Sub dp_KeyDown(KeyCode As Integer, ByVal Shift As Integer)
If KeyCode = FireOnThisKeyCode Then RaiseEvent KeyDown(KeyCode, Shift)
End Sub
To put in the userform:
Option Explicit
Dim WithEvents kp As KeyPreview
Private Sub UserForm_Initialize()
Set kp = New KeyPreview
kp.AddToPreview Me, 114
End Sub
Private Sub kp_KeyDown(ByVal KeyCode As Integer, ByVal Shift As Integer)
MsgBox "F3 was pressed..."
End Sub
It works with TextBoxes, OptionButtons, ListBoxes and DTPickers. Other Controls that could get focus will need to be handled aswell.
I'm developing a user form in Access. I have this code to open dropdown menu when mouse is on combobox:
Private Sub cmbx_ID_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Me.cmbx_ID.SetFocus
Me.cmbx_ID.Dropdown
End Sub
But I want to close dropdown menu when mouse is away from the combobox (now to close the form he should either select an item in dropdown menu or click on the form). I found that I can create a button and close the form when mouse is on this button:
Private Sub Frame1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
CommandButton1.SetFocus
SendKeys "{esc}", True
End Sub
but that not what I'd like.
I'm creating a Pop Up Menu to paste into an ActiveX Textbox on an Excel worksheet. The pop up works but the "Paste" option is grayed out.
Private Sub txtInput_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = vbKeyRButton Then
Call ShowMenu
Application.CommandBars("MyMenu").ShowPopup
End If
End Sub
Sub ShowMenu()
'Remove any old instance of MyPopUp
On Error Resume Next
CommandBars("MyMenu").Delete
On Error GoTo 0
With CommandBars.Add(name:="MyMenu", Position:=msoBarPopup)
With .Controls.Add(Type:=msoControlButton, ID:=22)
.Enabled = True
End With
End With
End Sub
I added in the .Enabled = True but that did not fix the issue. I'm sure I'm missing something basic.
Additional question, once the user can click paste, do I HAVE to add OnAction and refer to a sub to have it actually paste the text into the textbox or is using the msoControlButton with ID 22 enough to indicate the pasting of text?
Additional question, once the user can click paste, do I HAVE to add OnAction and refer to a sub to have it actually paste the text into the textbox or is using the msoControlButton with ID 22 enough to indicate the pasting of text?
No, you actually don't need to use either, because the ActiveX TextBox class has a Paste method which you can use. So, piggy-backing on #Mukul Varney's answer, within the cmdPasteButton_Click event procedure, you can simply do:
txtInput.Paste
And this should paste the clipboard contents at the cursor position in the TextBox.
Private Sub cmdPasteButton_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
txtInput.Paste
CancelDefault = True
End Sub
Try below. Paste is enabled for me.
Private WithEvents cmdPasteButton As CommandBarButton
Private Sub txtInput_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = vbKeyRButton Then
Call ShowMenu
Application.CommandBars("MyMenu").ShowPopup
End If
End Sub
Sub ShowMenu()
'Remove any old instance of MyPopUp
On Error Resume Next
CommandBars("MyMenu").Delete
On Error GoTo 0
Set cmdPasteButton = CommandBars.Add(Name:="MyMenu", Position:=msoBarPopup).Controls.Add(Type:=msoControlButton, ID:=22)
cmdPasteButton.OnAction = "Textbox_Paste"
End Sub
Private Sub cmdPasteButton_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
MsgBox "hello from cmdPasteButton_Click"
CancelDefault = True
End Sub
I was using the following code to select text inside a text box of a userform everytime I clicked on it, however I have almost 40 text boxes and I would like to know if there's a way to write a single code for all of them instead of copying and pasting this same piece of code 40 times.
Private Sub textbox1_MouseDown(ByVal Button As Integer, _
ByVal Shift As Integer,ByVal X As Single, ByVal y As Single)
With Me.textbox1
.SelStart = 0
.SelLength = Len(.Text)
End With
End Sub
There are ways to write a single instance that will run for them all.
You will need to add a line of code for the MouseDown event for each textbox that will call the single instance of the code.
For example: -
Private Sub TextBox1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
SelectText
End Sub
Then create a procedure that works on the ActiveControl: -
Private Sub SelectText()
With ActiveControl
.SelStart = 0
.SelLength = Len(.Text)
End With
End Sub