keyboard Shortcut for the ½ character

RincewindWIZZ

Board Regular
Joined
Feb 22, 2005
Messages
81
Hi

I have some tedious data entry to do into a spreadsheet. Mostly text.
Every once in a while I have to use the 1/2 character in a string

So I can copy and paste the character from the clipboard (very quick)
but copy/paste gets used a lot anyway so then I have
- to stop typing. go find the 1/2 character and copy/paste (very slow); or
- insert symbol (which is a slow process)
I dont seem to be able to create a keyboard shortcut
I cant execute a macro in the middle of typing a row of text

I tried using autocorrect to change 1/2 into the half character and that's not bad but it only seems to work if there is a space in front of the 1
so
21/2 does not change but
2 1/2 becomes 2½ which is great

Any better suggestions?

TFAI
 

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand
As an aside, there is a non-Excel solution to this. You would need to understand how to use AutoHotkey or own, say, a programmable mouse. Then you could run a macro when you please.

Gravanoc: AHK looks interesting but how do I get it and find out how to make it work? The website left me 'dazed'!!
 
Upvote 0
Hi RincewindWIZZ


Workbook example

I have given this a shot resorting to the windows API and it seems to give good results.

Basically, I have designed this OnKeyEx routine that works in a similar way as the native VBA OnKey Method but it works while excel is in Edit Mode.

The OnKeyEx takes 4 arguments namely the Virtual key code of the letter to be pressed, an optional Modifier key ( Ctrl, Alt .. etc), the optional name of the Macro to be executed when the key is pressed and finally, the optional sheet range on which the onkey is applied.

The following example shows how you can automatically enter the ½ character into the cell by just pressing the CTRL + SPACE BAR keys for easy use... ( change these keys as needed in the first arg )

In the example below, the code applies only to the range
Sheet1!A1:G20 ... Set this range as required in the 4th Optional argument or simply omit it so it applies to the entire workbook.



1- Code in the Standard Module:

Code:
[COLOR=#008000]
'The 'OnKeyEx' SUB runs a specified procedure when a particular key
'or key combination is pressed while excel is in EDIT MODE.[/COLOR]

Option Explicit

Public Enum MODIFIER_KEY
    MOD_ALT = &H1
    MOD_CONTROL = &H2
    MOD_SHIFT = &H4
    MOD_WIN = &H8
End Enum

Type POINTAPI
    x As Long
    y As Long
End Type


#If VBA7 Then

    Type MSG
        hwnd As LongPtr
        message As Long
        wParam As LongPtr
        lParam As LongPtr
        time As Long
        pt As POINTAPI
    End Type
    
    Declare PtrSafe Function RegisterHotKey Lib "user32" (ByVal hwnd As LongPtr, ByVal id As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long
    Declare PtrSafe Function UnregisterHotKey Lib "user32" (ByVal hwnd As LongPtr, ByVal id As Long) As Long
    Declare PtrSafe Function WaitMessage Lib "user32" () As Long
    Declare PtrSafe Function PeekMessage Lib "user32" Alias "PeekMessageA" (lpMsg As MSG, ByVal hwnd As LongPtr, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long
    Declare PtrSafe Function GetFocus Lib "user32" () As LongPtr
    Declare PtrSafe Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) As Long
    Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As Long
    Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr
    
#Else

    Type MSG
        hwnd As Long
        message As Long
        wParam As Long
        lParam As Long
        time As Long
        pt As POINTAPI
    End Type
    
    Declare Function RegisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal id As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long
    Declare Function UnregisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal id As Long) As Long
    Declare Function WaitMessage Lib "user32" () As Long
    Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" (lpMsg As MSG, ByVal hwnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long
    Declare Function GetFocus Lib "user32" () As Long
    Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) As Long
    Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Declare Function GetActiveWindow Lib "user32" () As Long
    
#End If





Public Sub OnKeyEx(ByVal vKeyCode As Integer, Optional ByVal ModifierKey As MODIFIER_KEY, Optional ByVal MacroName As String, Optional ApplyToRange As Range)
    
    Const PM_NOREMOVE = &H0: Const WM_HOTKEY = &H312
    
    Static lRet As Long
    Dim tMsg As MSG, oTempRange As Range


    On Error Resume Next
    
    Application.EnableCancelKey = xlDisabled
    
    If Not ApplyToRange Is Nothing Then
        Set oTempRange = Union(ActiveCell, ApplyToRange)
        If Err.Number = 0 Then
            If oTempRange.Address <> ApplyToRange.Address Then
                vKeyCode = 0
            End If
        Else
            vKeyCode = 0
        End If
    End If
    
    If vKeyCode = 0 Then
        lRet = UnregisterHotKey(Application.hwnd, &HBFFF&)
    Else
        Do While lRet = 0
            If GetActiveWindow <> Application.hwnd Then Exit Do
            Call RegisterHotKey(Application.hwnd, &HBFFF&, ModifierKey, vKeyCode)
            Call WaitMessage
            If PeekMessage(tMsg, Application.hwnd, WM_HOTKEY, WM_HOTKEY, PM_NOREMOVE) Then
                If tMsg.wParam = &HBFFF& Then
                    CallByName ThisWorkbook, MacroName, VbMethod
                End If
            End If
            DoEvents
        Loop
    End If
    
    Call UnregisterHotKey(Application.hwnd, &HBFFF&)
    
End Sub



2- Code in the ThisWorkbook Module:
Code:
Option Explicit

Private Const APPLY_TO_RANGE As String = "Sheet1!A1:G20" [COLOR=#008000]' <== Change Range to suit.[/COLOR]
Private Const ONKEY_MACRO_NAME As String = "OnkeyMacro" [COLOR=#008000]' <== Change Macro name to suit.[/COLOR]



[COLOR=#008000]'MAIN ROUTINE.
[/COLOR][COLOR=#008000]'PRESSING (CTRL + SPACEBAR) WILL EXECUTE THE MACRO : 'OnkeyMacro'[/COLOR]
Private Sub HookKey(ByVal OnKeyMacroName As String)
    Call OnKeyEx(VBA.vbKeySpace, MOD_CONTROL, OnKeyMacroName, Range(APPLY_TO_RANGE))
End Sub


[COLOR=#008000]'THIS OnKeyMacro MUST BE PUBLIC !!!![/COLOR]
Public Sub OnkeyMacro()

    Const WM_CHAR = &H102
    Const KEY_SENT As String = "½" [COLOR=#008000]' <== Change Character sent to suit.[/COLOR]
    
    Call PostMessage(GetFocus, WM_CHAR, Asc(KEY_SENT), MapVirtualKey(Asc(KEY_SENT), 0&))
    DoEvents

End Sub



Private Sub Workbook_Activate()
    Call HookKey(ONKEY_MACRO_NAME)
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Call HookKey(ONKEY_MACRO_NAME)
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Call HookKey(ONKEY_MACRO_NAME)
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    OnKeyEx False
End Sub


Code written and tested on excel 2016 64bit
 
Upvote 0
Hi RincewindWIZZ


Workbook example

I have given this a shot resorting to the windows API and it seems to give good results.

Basically, I have designed this OnKeyEx routine that works in a similar way as the native VBA OnKey Method but it works while excel is in Edit Mode.

The OnKeyEx takes 4 arguments namely the Virtual key code of the letter to be pressed, an optional Modifier key ( Ctrl, Alt .. etc), the optional name of the Macro to be executed when the key is pressed and finally, the optional sheet range on which the onkey is applied.

etc

Truly awesome and so far beyond my VBA knowledge as to seem almost magical . . . or something like that
Anyway thanks . . . . . but!!

so I had a go . . .
Copied the code into my workbook (So there is an API_bas in the Modules and the rest of the code is in ThisWorkBook)
Created a Sheet1 and it all worded brilliantly

Changed APPLY_TO_RANGE to "Notes!A1:G20" (Notes being the name of one of the sheets in the workbook) and it stopped working. Instead it selected the entire column.


So I changed APPLY_TO_RANGE back to Sheet1!A1:G20 and checked that it still worked - it did (on sheet1)!

Then removed the 4th parameter from the call on Onkey (now
Code:
Call OnKeyEx(VBA.vbKeySpace, MOD_CONTROL, OnKeyMacroName))

That works fine in Sheet1 but does nothing in the sheet named Notes (or any of the others I tried).
Nothing means absolutely nothing, no half character, no column selected, nothing.

Some background:
The spreadsheet has a new page added every year and this feature needs to work on all of these sheets. Or if its easier, it just needs to work on the active sheet (Hardly relevant on the non-active sheet!!!)

Actually it can work throughout the entire workbook since there is no need for the normal ctrl-sace hotkey
hopefully that makes it a bit simpler?

Thanks for any thoughts
 
Upvote 0
Hi RincewindWIZZ,

That is strange ... as per your description, you seem to have adapted the code to the name of your sheet correctly.

Can you upload a test copy of your workbook to a file sharing site and post a link here so that I can take a look ?

Regards
 
Last edited:
Upvote 0
Hi RincewindWIZZ,

That is strange ... as per your description, you seem to have adapted the code to the name of your sheet correctly.

Can you upload a test copy of your workbook to a file sharing site and post a link here so that I can take a look ?

Regards


No worries but it will have to wait until tomorrow as I am off to the pub with my daughter

Thanks for your help
 
Upvote 0
Hi RincewindWIZZ

I have revised the code and have fixed a couple of bugs .. Give this revised version a shot and let me know :

workbook example
(fixed version)


1- Revised code in the Standard Module:
Code:
[COLOR=#008000]'The 'OnKeyEx' SUB runs a specified procedure when a particular key
'or key combination is pressed while excel is in EDIT MODE.[/COLOR]

Option Explicit

Public Enum MODIFIER_KEY
    MOD_ALT = &H1
    MOD_CONTROL = &H2
    MOD_SHIFT = &H4
    MOD_WIN = &H8
End Enum

Type POINTAPI
    x As Long
    y As Long
End Type


#If VBA7 Then

    Type MSG
        hwnd As LongPtr
        message As Long
        wParam As LongPtr
        lParam As LongPtr
        time As Long
        pt As POINTAPI
    End Type
    
    Declare PtrSafe Function RegisterHotKey Lib "user32" (ByVal hwnd As LongPtr, ByVal id As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long
    Declare PtrSafe Function UnregisterHotKey Lib "user32" (ByVal hwnd As LongPtr, ByVal id As Long) As Long
    Declare PtrSafe Function WaitMessage Lib "user32" () As Long
    Declare PtrSafe Function PeekMessage Lib "user32" Alias "PeekMessageA" (lpMsg As MSG, ByVal hwnd As LongPtr, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long
    Declare PtrSafe Function GetFocus Lib "user32" () As LongPtr
    Declare PtrSafe Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) As Long
    Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As Long
    Declare PtrSafe Function GetForegroundWindow Lib "user32" () As LongPtr
    Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    
#Else

    Type MSG
        hwnd As Long
        message As Long
        wParam As Long
        lParam As Long
        time As Long
        pt As POINTAPI
    End Type
    
    Declare Function RegisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal id As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long
    Declare Function UnregisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal id As Long) As Long
    Declare Function WaitMessage Lib "user32" () As Long
    Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" (lpMsg As MSG, ByVal hwnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long
    Declare Function GetFocus Lib "user32" () As Long
    Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) As Long
    Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Declare Function GetForegroundWindow Lib "user32" () As Long
    Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    
#End If



Public Sub OnKeyEx(ByVal vKeyCode As Integer, Optional ByVal ModifierKey As MODIFIER_KEY, Optional ByVal MacroName As String, Optional ApplyToRange As Range)
    
    Const PM_NOREMOVE = &H0: Const WM_HOTKEY = &H312
    
    Static lRet As Long
    Dim tMsg As MSG, oTempRange As Range


    On Error Resume Next
    
    Application.EnableCancelKey = xlDisabled
    
    If Not ApplyToRange Is Nothing Then
        Set oTempRange = Union(ActiveCell, ApplyToRange)
        If Err.Number = 0 Then
            If oTempRange.Address <> ApplyToRange.Address Then
                vKeyCode = 0
            Else
                lRet = 0
            End If
        Else
            vKeyCode = 0
        End If
        lRet = 0
    End If
    
    If vKeyCode = 0 Then
        lRet = UnregisterHotKey(Application.hwnd, &HBFFF&)
    Else
        Do While lRet = 0
            If GetForegroundWindow = FindWindow("wndclass_desked_gsk", vbNullString) Then Exit Do
            Call RegisterHotKey(Application.hwnd, &HBFFF&, ModifierKey, vKeyCode)
            Call WaitMessage
            If PeekMessage(tMsg, Application.hwnd, WM_HOTKEY, WM_HOTKEY, PM_NOREMOVE) Then
                If tMsg.wParam = &HBFFF& Then
                    CallByName ThisWorkbook, MacroName, VbMethod
                End If
            End If
            DoEvents
        Loop
    End If
    
    Call UnregisterHotKey(Application.hwnd, &HBFFF&)

End Sub



2- Revised code in the ThisWorkbook Module:
Code:
Option Explicit

Private Const APPLY_TO_RANGE As String = "Sheet1!A1:G20" [COLOR=#008000]' <== Change Range to suit.[/COLOR]
Private Const ONKEY_MACRO_NAME As String = "OnkeyMacro" [COLOR=#008000]' <== Change Macro name to suit.[/COLOR]


[COLOR=#008000]'MAIN ROUTINE.
'PRESSING (CTRL + SPACEBAR) WILL EXECUTE THE MACRO : 'OnkeyMacro'[/COLOR]
Private Sub HookKey(ByVal OnKeyMacroName As String)

    On Error GoTo errHandler
    
    Call OnKeyEx(VBA.vbKeySpace, MOD_CONTROL, OnKeyMacroName, Range(APPLY_TO_RANGE))
   
   Exit Sub
errHandler:
    MsgBox "Runtime Error :" & Err.Number & vbCrLf & vbCrLf & Err.Description
    
End Sub


[COLOR=#008000]'THIS OnKeyMacro MUST BE PUBLIC !!!![/COLOR]
Public Sub OnkeyMacro()

    Const WM_CHAR = &H102
    Const KEY_SENT As String = "½" [COLOR=#008000]' <== Change Character sent to suit.[/COLOR]
    
    Call PostMessage(GetFocus, WM_CHAR, Asc(KEY_SENT), MapVirtualKey(Asc(KEY_SENT), 0&))
    DoEvents

End Sub



Private Sub Workbook_Activate()
    Call HookKey(ONKEY_MACRO_NAME)
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Call HookKey(ONKEY_MACRO_NAME)
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Call HookKey(ONKEY_MACRO_NAME)
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call OnKeyEx(False)
End Sub
 
Upvote 0
Hi RincewindWIZZ

I have revised the code and have fixed a couple of bugs .. Give this revised version a shot and let me know :

Thanks

The problem I have is related to unlocked cells and protected worksheets
It all works fine except when I press ctrl-space in an unlocked cell in a protected worksheet
I will try your latest version and report back
Thanks
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,213
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top