Hello,
I've already tried to use the Office.CommandBars class to implement popup menu with text boxes. It seems to perfectly work on Excel, but I don't actually develop the userform in Excel, but in CATIA (CAD software which comes along VBA7 64 bits). Importing the Office library doesn't seem to work.
I've already read that text boxes don't provide any window handle (windowless). Is there another way to capture the selected text. If I use the GetWindowFromPoint function it returns the handle of desktop.. I'm not really optimistic using the handle of the userform as it is not an Edit class.
Ps : I've writtent all API declarations in the API module and the misc module contains some other functions / subs which are not important..
Does anyone has a solution about the issue?
Thanks
I've already tried to use the Office.CommandBars class to implement popup menu with text boxes. It seems to perfectly work on Excel, but I don't actually develop the userform in Excel, but in CATIA (CAD software which comes along VBA7 64 bits). Importing the Office library doesn't seem to work.
I've already read that text boxes don't provide any window handle (windowless). Is there another way to capture the selected text. If I use the GetWindowFromPoint function it returns the handle of desktop.. I'm not really optimistic using the handle of the userform as it is not an Edit class.
Code:
'
Public Sub popup()
Dim Pt As API.POINT: API.GetCursorPos lpPoint:=Pt
Dim hwnd As LongPtr: hwnd = API.WindowFromPoint(xPoint:=Pt.X, yPoint:=Pt.Y)
Dim hMenu As LongPtr: hMenu = API.CreatePopupMenu()
API.AppendMenu hMenu:=hMenu, wFlags:=API.MF_STRING, wIDNewItem:=1, lpNewItem:="&Copy"
API.AppendMenu hMenu:=hMenu, wFlags:=API.MF_STRING, wIDNewItem:=2, lpNewItem:="C&ut"
API.AppendMenu hMenu:=hMenu, wFlags:=API.MF_STRING, wIDNewItem:=3, lpNewItem:="&Paste"
Dim lpRC As API.RECT
Select Case API.TrackPopupMenu(hMenu:=hMenu, uFlags:=API.TPM_LEFTALIGN Or API.TPM_RETURNCMD Or API.TPM_RIGHTBUTTON, X:=Pt.X, Y:=Pt.Y, nReserved:=0&, hwnd:=hwnd, lpRC:=lpRC)
Case 1: 'misc.setClipboard
Dim startpos As Long, endpos As Long
Dim lRet As Long: lRet = API.SendMessage(hwnd:=hwnd, wMsg:=API.EM_GETSEL, wParam:=startpos, lParam:=endpos)
Dim lpClassName As String: lpClassName = VBA.Space$(255)
lRet = API.GetClassName(hwnd:=hwnd, lpClassName:=lpClassName, nMaxCount:=Len(lpClassName))
Debug.Print hwnd, VBA.left$(lpClassName, lRet), hMenu, lRet, startpos, endpos ' => returns "wndclass_desked_gsk" for the window class name
' Dim wParam As Long
'
' Dim lRet As Long: lRet = API.SendMessage(hWnd:=hWnd, wMsg:=API.EM_GETSEL, wParam:=wParam, lParam:=0&)
'
' Debug.Print hWnd, hMenu, lRet, misc.LOWORD(wParam), misc.HIWORD(wParam)
If Err.LastDllError Then Debug.Print misc.GetSystemErrorMessageText(ErrorNumber:=Err.LastDllErr) ' no error
Case 2:
Case 3: 'misc.getClipboard
End Select
API.DestroyMenu hMenu:=hMenu
End SubPs : I've writtent all API declarations in the API module and the misc module contains some other functions / subs which are not important..
Does anyone has a solution about the issue?
Thanks
