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
Related
This question already has answers here:
How to add a menu item to the default right click context menu
(3 answers)
Closed 2 years ago.
I have a treeview on my form and I'm trying to create a right click context menu that gives some options for a particular node. This is my first time using the CommandBar functionality.
In the form with the Treeview, there is the following subroutine:
Public Sub MyTreeview_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Long, ByVal y As Long)
'Clicking right mouse button activates subroutine
If Button = 2 Then
RightClickNodeOptions
End If
End Sub
Then in a separate module I've created a test subroutine to check the functionality:
Public Sub RightClickNodeOptions()
Dim cmdBAR As CommandBar
Set cmdBAR = CommandBars.Add(, msoBarPopup, False, True)
Dim cmdButtonAddChild As CommandBarButton
Set cmdButtonAddChild = cmdBAR.Controls.Add(msoControlButton)
Dim cmdButtonAddSibling As CommandBarButton
Set cmdButtonAddSibling = cmdBAR.Controls.Add(msoControlButton)
cmdButtonAddChild.Caption = "Add Child to Tree"
cmdButtonAddChild.OnAction = MsgBox("Child")
cmdButtonAddSibling.Caption = "Add Sibling to Tree"
cmdButtonAddSibling.OnAction = MsgBox("Sibling")
cmdBAR.ShowPopup
Set cmdBAR = Nothing
Set cmdButtonAddChild = Nothing
Set cmdButtonAddSibling = Nothing
End Sub
When I right click in the Treeview, both message boxes automatically pop up in order ("Child", "Sibling") before I've had a chance to select an option, then the CommandBar pops up with the two options. If I then click in one of the options in the commandbar, nothing happens.
Personally, I don't make it temporary (so I can call it by name) but instead I delete and recreate it as needed.
Change the sub to a function to check the context menu was created successfully to avoid errors and then call its ShowPopup() method. You also need to cancel the event as it messes up with the context menu.
Private Function CreateRightClickNodeOptions() As Boolean
'delete existing
On Error Resume Next
CommandBars("NodeOptions").Delete
On Error GoTo Trap
Dim cmdBAR As CommandBar
Set cmdBAR = CommandBars.Add("NodeOptions", msoBarPopup, False, False)
'...
' remove ShowPopup() method from here
'all good
CreateRightClickNodeOptions= True
Leave:
On Error GoTo 0
Exit Function
Trap:
MsgBox Err.Description, vbCritical
Resume Leave
End Function
Then, in your event handler check for right click and the context menu was created successfully before calling it.
Public Sub MyTreeview_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Long, ByVal y As Long)
If Button = acRightButton Then
If Not CreateRightClickNodeOptions() Then Exit Sub
CommandBars("NodeOptions").ShowPopup
DoCmd.CancelEvent
End If
End Sub
Obviously if you don't have dynamic inputs you can create it only once and leave it, but if you need to pass varying parameters to the methods, you need to delete and recreate it.
I have an ActiveX Combobox in one of my main sheet which control/update a series of charts.
Private Sub cmBoxSelect_GotFocus()
Application.ScreenUpdating = False
With Me.cmBoxSelect
.List = Array("Grand Total", "Prod1", "Prod2", "Prod3", "Prod4", "Prod5")
.ListRows = 6
.DropDown
End With
Application.ScreenUpdating = True
End Sub
Private Sub cmBoxSelect_Change()
'series of codes which manipulates the charts, based on selection...
End Sub
I noticed that when I click the ComboBox and select one of its content, it leaves a blue highlight on the selection. So to prevent that, I added:
Private Sub cmBoxSelect_DropButtonClick()
Application.ScreenUpdating = False
ActiveCell.Activate
Application.ScreenUpdating = True
End Sub
It successfully removed the highlight.
However, it has a weird drawback. cmbSelect doesn't close automatically once user didn't select anything (once the combobox is active and the user click any cell in the sheet, it doesn't close out). It was working before I added the DropButtonClick event.
Did I missed anything or any wrong steps above? Thanks for your inputs!
EDIT#1
Seems I already found a solution by trial and error. I only added a blank Label and select it to remove the focus out of the ComboBox whenever there is a change. I also changed the DropButtonClick to LostFocus.
Private Sub cmBoxSelect_GotFocus()
Application.ScreenUpdating = False
With Me.cmBoxSelect
.List = Array("Grand Total", "Prod1", "Prod2", "Prod3", "Prod4", "Prod5")
.ListRows = 6
.DropDown
End With
Application.ScreenUpdating = True
End Sub
Private Sub cmBoxSelect_LostFocus()
ActiveCell.Select
End Sub
Private Sub cmBoxSelect_Change()
'series of codes which manipulates the charts, based on selection...
Me.Label1.Select
End Sub
You need to put the SelLength to 0 in multiple events to avoid highlighting:
so:
Me.cmBoxSelect.SelLength = 0
in:
Private Sub cmBoxSelect_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Private Sub cmBoxSelect_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Private Sub cmBoxSelect_LostFocus()
Private Sub cmBoxSelect_DropButtonClick()
Private Sub cmBoxSelect_Change()
Private Sub cmBoxSelect_GotFocus()
(you could add also Me.cmBoxSelect.SelStart = 0 )
Lets try this:
Not Event-triggered by a change, but by the dropbuttonclick
Private Sub changingComboBox(String s)
'series of codes which manipulates the charts, based on selection...
End Sub
Private Sub cmBoxSelect_DropButtonClick()
Dim s As String
s = cmBoxSelect.SelText
If (cmBoxSelect.SelText = cmBoxSelect.Value) Then
cmBoxSelect.Value = ""
cmBoxSelect.Value = s
Else
call changingComboBox(cmBoxSelect.Value)
End If
End Sub
How about that ?
I have a spreadsheet with 4 ActiveX Image boxes with some code that opens a file window if you double click on the box to load a picture into it but if you double click on the box but then choose not to add a photo and hit cancel it returns RunTime Error: 53. Is there something simple I can add to my code so that if you cancel out it doesn't cause an error? Code below.
Private Sub Image1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Image1.Picture = LoadPicture(Application.GetOpenFilename)
End Sub
Private Sub Image2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Image2.Picture = LoadPicture(Application.GetOpenFilename)
End Sub
Private Sub Image3_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Image3.Picture = LoadPicture(Application.GetOpenFilename)
End Sub
Private Sub Image4_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Image4.Picture = LoadPicture(Application.GetOpenFilename)
End Sub
Any help would be much appreciated.
Make a little function that returns Empty if no picture is selected:
Private Function GetUserSelectedPicture() As Variant
Dim path As Variant
path = Application.GetOpenFilename 'returns a Boolean if cancelled
If VarType(path) <> vbBoolean Then
GetUserSelectedPicture = LoadPicture(path)
End If
End Function
Then update your handlers to invoke it:
Image1.Picture = GetUserSelectedPicture
Note that it will fail to load certain image formats, such as .png.
I am trying to close a UserForm if a person clicks the red x in the upper right hand corner. Here is my code so far.
Public Sub Worksheet_BeforeDoubleClick(ByVal target As Range, Cancel As Boolean)
If target.Column = 10 Then
UserForm2.Show
etc...
Now, the Form opens and I run this code...
Public Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then
If Not ExitAsk = vbYes Then Cancel = True
End If
End Sub
Public Function ExitAsk() As VbMsgBoxResult
Dim Smsg As String
Smsg = "Are you really want to exit? Click Yes to terminate or No to Continue."
ExitAsk = MsgBox(Smsg, vbYesNo + vbDefaultButton2 + vbQuestion, "Exit!")
End Function
Then, focus goes back to the Sub, and the code continues to run through everything, which causes some problems for me. I want to click the red x and close the UserForm and exit the Sub. It seem like the Sub and UserForm don't communicate, even though both are declared a Public. I must be missing something simple, but I'm not sure what. Any ideas, anyone?
Thanks!
It seem like the Sub and UserForm don't communicate, even though both are declared a Public
Accessibility has nothing to do with whether a procedure communicates with a form. A form is an object, not very different from a Range or a Collection - except it has a designer and a default instance: it won't "communicate" with your procedure without you telling it how to do that.
First, stop using the default instance and treat the form as you would any other object: New it up!
With New UserForm2 'object instance starts existing here...
.Show 'vbModal is implicit
End With '...and dies here
Now if you want the calling code to know how the form was closed, you need to expose something that the calling code can access to know that.
That's best done with a property. You could also expose a public field, but then the calling code would be able to tamper with it and you don't want that - that's what encapsulation does:
Private isCancelled As Boolean
Public Property Get Cancelled() As Boolean
Cancelled = isCancelled
End Property
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then
isCancelled = True
End If
Cancel = True
Me.Hide
End Sub
Notice Cancel = True and Me.Hide: without cancelling the close, the object gets destroyed immediately and you lose its state. So you want to Hide the form instead of unloading/destroying it.
Only the form's code-behind can access isCancelled, but the calling code can read the Cancelled property (but not write to it).
With New UserForm2 'object instance starts existing here...
.Show vbModal 'execution in this procedure will resume after form is closed
If .Cancelled Then
'form was X'd out
End If
End With '...and dies here
So... not sure what you're trying to achieve exactly, but you'll want something along these lines.
In UserForm you can define your own public Get-property e.g. CloseModeInfo which will return value of private member which can be set in UserForm_QueryClose. Value of this public property can be then tested later. According to value in this property the calling code will decide what to do. HTH
UserForm
Private m_closeModeInfo As Integer
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
m_closeModeInfo = CloseMode
If CloseMode = vbFormControlMenu Then
If Not ExitAsk = vbYes Then Cancel = True
End If
End Sub
Private Function ExitAsk() As VbMsgBoxResult
Dim Smsg As String
Smsg = "Are you really want to exit? Click Yes to terminate or No to Continue."
ExitAsk = MsgBox(Smsg, vbYesNo + vbDefaultButton2 + vbQuestion, "Exit!")
End Function
Public Property Get CloseModeInfo() As Integer
CloseModeInfo = m_closeModeInfo
End Property
Worksheet Code
Private Sub Worksheet_BeforeDoubleClick(ByVal target As Range, Cancel As Boolean)
If target.Column = 10 Then
Dim frm As UserForm2
Set frm = New UserForm2
UserForm2.Show
If frm.CloseModeInfo = vbFormControlMenu Then
Unload frm
' I want to click the red x and close the UserForm and exit the Sub:
Exit Sub
End If
End If
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