Pasting Into Excel Form

rutherfordcpa
rutherfordcpa used Ask the Experts™
on
We have a form in Excel, bu we can't right click and paste anything into... we have to manually type the information.  Can a paste function be enabled?
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®

Commented:
If you single click a cell, sometimes it won't allow you to paste to that location as the formatting differs.

Try double clicking the cell you want to paste into so that a typing cursor appears, and paste it then,
David AtkinTechnical Director
Top Expert 2015

Commented:
Ctrl + V into the box at the top.
I think we are talking about an Excel UserForm rather than a Worksheet?

You will need to use VBA to create a context menu that works in TextBoxes in a UserForm.  

The following snippets will add a right-click menu with Copy/Cut/Paste/Delete/SelectAll functionality to every TextBox on a given UserForm..

In the UserForm code itself
Option Explicit

Private HoldReferences As Collection

Private Sub UserForm_Initialize()
 Dim c As Control, Rccm As RightClickContextMenu
 
 Set HoldReferences = New Collection

 For Each c In Me.Controls
 If TypeName(c) = "TextBox" Then
 Set Rccm = New RightClickContextMenu
 Call Rccm.SetUp(Me, c)
 HoldReferences.Add Rccm
 End If
 Next
End Sub

Open in new window


In a new Module
Option Explicit

'http://word.mvps.org/FAQS/Userforms/AddRightClickMenu.htm

' Required API declarations
Private Declare Function CreatePopupMenu Lib "user32" () As Long
Private Declare Function InsertMenuItem Lib "user32" Alias "InsertMenuItemA" (ByVal hMenu As Long, ByVal un As Long, ByVal bool As Boolean, ByRef lpcMenuItemInfo As MENUITEMINFO) As Long
Private Declare Function TrackPopupMenu Lib "user32" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal X As Long, ByVal Y As Long, ByVal nReserved As Long, ByVal hwnd As Long, lprc As RECT) As Long
Private Declare Function DestroyMenu Lib "user32" (ByVal hMenu As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

' Type required by TrackPopupMenu although this is ignored !!
Private Type RECT
 Left As Long
 Top As Long
 Right As Long
 Bottom As Long
End Type

' Type required by InsertMenuItem
Private Type MENUITEMINFO
 cbSize As Long
 fMask As Long
 fType As Long
 fState As Long
 wID As Long
 hSubMenu As Long
 hbmpChecked As Long
 hbmpUnchecked As Long
 dwItemData As Long
 dwTypeData As String
 cch As Long
End Type

' Type required by GetCursorPos
Private Type POINTAPI
 X As Long
 Y As Long
End Type

' Constants required by TrackPopupMenu
Private Const TPM_LEFTALIGN = &H0&
Private Const TPM_TOPALIGN = &H0
Private Const TPM_RETURNCMD = &H100
Private Const TPM_RIGHTBUTTON = &H2&

' Constants required by MENUITEMINFO type
Private Const MIIM_STATE = &H1
Private Const MIIM_ID = &H2
Private Const MIIM_TYPE = &H10
Private Const MFT_STRING = &H0
Private Const MFT_SEPARATOR = &H800
Private Const MFS_DEFAULT = &H1000
Private Const MFS_ENABLED = &H0
Private Const MFS_GRAYED = &H1

' Contants defined by me for menu item IDs
Private Const ID_Cut = 101
Private Const ID_Copy = 102
Private Const ID_Paste = 103
Private Const ID_Delete = 104
Private Const ID_SelectAll = 105


' Variables declared at module level
Private FormCaption As String
Private Cut_Enabled As Long
Private Copy_Enabled As Long
Private Paste_Enabled As Long
Private Delete_Enabled As Long
Private SelectAll_Enabled As Long



Public Sub ShowPopup(oControl As msforms.TextBox, oForm As UserForm, strCaption As String, X As Single, Y As Single)

 Static click_flag As Long

 ' The following is required because the MouseDown event
 ' fires twice when right-clicked !!
 click_flag = click_flag + 1

 ' Do nothing on first firing of MouseDown event
 If (click_flag Mod 2 <> 0) Then Exit Sub

 ' Set object reference to the textboxthat was clicked
 'Set oControl = oForm.ActiveControl

 ' If click is outside the textbox, do nothing
 If X > oControl.Width Or Y > oControl.Height Or X < 0 Or Y < 0 Then Exit Sub

 ' Retrieve caption of UserForm for use in FindWindow API
 FormCaption = strCaption

 ' Call routine that sets menu items as enabled/disabled
 Call EnableMenuItems(oControl, oForm)

 ' Call function that shows the menu and return the ID
 ' of the selected menu item. Subsequent action depends
 ' on the returned ID.
 Select Case GetSelection()
 Case ID_Cut
 oControl.Cut
 Case ID_Copy
 oControl.Copy
 Case ID_Paste
 oControl.Paste
 Case ID_Delete
 oControl.SelText = ""
 Case ID_SelectAll
 With oControl
 .SelStart = 0
 .SelLength = Len(oControl.Text)
 End With
 End Select

End Sub

Private Sub EnableMenuItems(oControl As msforms.TextBox, oForm As UserForm)

 Dim oData As DataObject
 Dim testClipBoard As String

 On Error Resume Next

 ' Set object variable to clicked textbox
 'Set oControl = oForm.ActiveControl

 ' Create DataObject to access the clipboard
 Set oData = New DataObject

 ' Enable Cut/Copy/Delete menu items if text selected
 ' in textbox
 If oControl.SelLength > 0 Then
 Cut_Enabled = MFS_ENABLED
 Copy_Enabled = MFS_ENABLED
 Delete_Enabled = MFS_ENABLED
 Else
 Cut_Enabled = MFS_GRAYED
 Copy_Enabled = MFS_GRAYED
 Delete_Enabled = MFS_GRAYED
 End If

 ' Enable SelectAll menu item if there is any text in textbox
 If Len(oControl.Text) > 0 Then
 SelectAll_Enabled = MFS_ENABLED
 Else
 SelectAll_Enabled = MFS_GRAYED
 End If

 ' Get data from clipbaord
 oData.GetFromClipboard

 ' Following line generates an error if there
 ' is no text in clipboard
 testClipBoard = oData.GetText

 ' If NO error (ie there is text in clipboard) then
 ' enable Paste menu item. Otherwise, diable it.
 If Err.Number = 0 Then
 Paste_Enabled = MFS_ENABLED
 Else
 Paste_Enabled = MFS_GRAYED
 End If

 ' Clear the error object
 Err.Clear

 ' Clean up object references
 'Set oControl = Nothing
 Set oData = Nothing

End Sub

Private Function GetSelection() As Long

 Dim menu_hwnd As Long
 Dim form_hwnd As Long
 Dim oMenuItemInfo1 As MENUITEMINFO
 Dim oMenuItemInfo2 As MENUITEMINFO
 Dim oMenuItemInfo3 As MENUITEMINFO
 Dim oMenuItemInfo4 As MENUITEMINFO
 Dim oMenuItemInfo5 As MENUITEMINFO
 Dim oMenuItemInfo6 As MENUITEMINFO
 Dim oRect As RECT
 Dim oPointAPI As POINTAPI

 ' Find hwnd of UserForm - note different classname
 ' Word 97 vs Word2000
 #If VBA6 Then
 form_hwnd = FindWindow("ThunderDFrame", FormCaption)
 #Else
 form_hwnd = FindWindow("ThunderXFrame", FormCaption)
 #End If

 ' Get current cursor position
 ' Menu will be drawn at this location
 GetCursorPos oPointAPI

 ' Create new popup menu
 menu_hwnd = CreatePopupMenu

 ' Intitialize MenuItemInfo structures for the 6
 ' menu items to be added

 ' Cut
 With oMenuItemInfo1
 .cbSize = Len(oMenuItemInfo1)
 .fMask = MIIM_STATE Or MIIM_ID Or MIIM_TYPE
 .fType = MFT_STRING
 .fState = Cut_Enabled
 .wID = ID_Cut
 .dwTypeData = "Cut"
 .cch = Len(.dwTypeData)
 End With

 ' Copy
 With oMenuItemInfo2
 .cbSize = Len(oMenuItemInfo2)
 .fMask = MIIM_STATE Or MIIM_ID Or MIIM_TYPE
 .fType = MFT_STRING
 .fState = Copy_Enabled
 .wID = ID_Copy
 .dwTypeData = "Copy"
 .cch = Len(.dwTypeData)
 End With

 ' Paste
 With oMenuItemInfo3
 .cbSize = Len(oMenuItemInfo3)
 .fMask = MIIM_STATE Or MIIM_ID Or MIIM_TYPE
 .fType = MFT_STRING
 .fState = Paste_Enabled
 .wID = ID_Paste
 .dwTypeData = "Paste"
 .cch = Len(.dwTypeData)
 End With

 ' Separator
 With oMenuItemInfo4
 .cbSize = Len(oMenuItemInfo4)
 .fMask = MIIM_TYPE
 .fType = MFT_SEPARATOR
 End With

 ' Delete
 With oMenuItemInfo5
 .cbSize = Len(oMenuItemInfo5)
 .fMask = MIIM_STATE Or MIIM_ID Or MIIM_TYPE
 .fType = MFT_STRING
 .fState = Delete_Enabled
 .wID = ID_Delete
 .dwTypeData = "Delete"
 .cch = Len(.dwTypeData)
 End With

 ' SelectAll
 With oMenuItemInfo6
 .cbSize = Len(oMenuItemInfo6)
 .fMask = MIIM_STATE Or MIIM_ID Or MIIM_TYPE
 .fType = MFT_STRING
 .fState = SelectAll_Enabled
 .wID = ID_SelectAll
 .dwTypeData = "Select All"
 .cch = Len(.dwTypeData)
 End With

 ' Add the 6 menu items
 InsertMenuItem menu_hwnd, 1, True, oMenuItemInfo1
 InsertMenuItem menu_hwnd, 2, True, oMenuItemInfo2
 InsertMenuItem menu_hwnd, 3, True, oMenuItemInfo3
 InsertMenuItem menu_hwnd, 4, True, oMenuItemInfo4
 InsertMenuItem menu_hwnd, 5, True, oMenuItemInfo5
 InsertMenuItem menu_hwnd, 6, True, oMenuItemInfo6

 ' Return the ID of the item selected by the user
 ' and set it the return value of the function
 GetSelection = TrackPopupMenu _
 (menu_hwnd, _
 TPM_LEFTALIGN Or TPM_TOPALIGN Or TPM_RETURNCMD Or TPM_RIGHTBUTTON, _
 oPointAPI.X, oPointAPI.Y, _
 0, form_hwnd, oRect)

 ' Destroy the menu
 DestroyMenu menu_hwnd

End Function

Open in new window


In a new Class Module that you must name RightClickContextMenu
Option Explicit

Private WithEvents pTextBox As msforms.TextBox
Private pUserFormReference As UserForm

Private Sub pTextBox_MouseDown(ByVal Button As Integer, _
 ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
 Debug.Print "Clicked"
 If Button = 2 Then
 Debug.Print pTextBox.Text
 Call ShowPopup(pTextBox, pUserFormReference, pUserFormReference.Caption, X, Y)
 End If
End Sub

Public Sub SetUp(UserFormReference As UserForm, TextboxReference As msforms.TextBox)
 Set pUserFormReference = UserFormReference
 Set pTextBox = TextboxReference
End Sub

Open in new window

Learn Ruby Fundamentals

This course will introduce you to Ruby, as well as teach you about classes, methods, variables, data structures, loops, enumerable methods, and finishing touches.

Author

Commented:
influenz:

Could I trouble you to place the code in a sample workbook so that I can see the setup?
Yes, not a problem but I'm mobile at the moment so will be about an hour before I'm back infront of a PC.
I've attached a sample file.  If you run UserForm1 from the VBA project the TextBox has a right-click context menu as described previously.
UserFormContextMenuSample.xlsm

Author

Commented:
Thank you for the sample!  That did the trick!
Great, you're welcome.

Author

Commented:
influenz:

Your code appears not to be Office x64 compliant.  I fixed some of the code via "PtrSafe", but can't seem to get the right click in x64.  Can you update your spreadsheet and adjust your code to be both compliant in x32 and x64?


Thanks,
Doug
I think I tested that answer on x64, that's what I'm usually working on. Will check and reply on your new question.

Author

Commented:
Thanks... be sure it is Office x64 rather than just Windows x64.  Office 2010 can be installed x32 or x64.

Author

Commented:
Any luck? I do konw the API delcarations need to be as follows:

#If VBA7 Then

Private Declare PtrSafe Function CreatePopupMenu Lib "user32" () As Long
Private Declare PtrSafe Function InsertMenuItem Lib "user32" Alias "InsertMenuItemA" (ByVal hMenu As Long, ByVal un As Long, ByVal bool As Boolean, ByRef lpcMenuItemInfo As MENUITEMINFO) As Long
Private Declare PtrSafe Function TrackPopupMenu Lib "user32" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal X As Long, ByVal Y As Long, ByVal nReserved As Long, ByVal hwnd As Long, lprc As RECT) As Long
Private Declare PtrSafe Function DestroyMenu Lib "user32" (ByVal hMenu As Long) As Long
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

#Else

Private Declare Function CreatePopupMenu Lib "user32" () As Long
Private Declare Function InsertMenuItem Lib "user32" Alias "InsertMenuItemA" (ByVal hMenu As Long, ByVal un As Long, ByVal bool As Boolean, ByRef lpcMenuItemInfo As MENUITEMINFO) As Long
Private Declare Function TrackPopupMenu Lib "user32" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal X As Long, ByVal Y As Long, ByVal nReserved As Long, ByVal hwnd As Long, lprc As RECT) As Long
Private Declare Function DestroyMenu Lib "user32" (ByVal hMenu As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

#End If

Author

Commented:
influenz:

I really need your help.

Thanks,
Doug

Author

Commented:
influenz:

Will you be able to assist?

Thanks,
Doug

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial