vb.net - How to perform .Onkey Event in an Excel Add-In created with Visual Studio 2010?

Question

I am creating an Excel Add-In using Visual Studio 2010. I would like to run some code when users clicks a combination of keys.

Here is the code I have got

Public Class CC

Private Sub ThisAddIn_Startup() Handles Me.Startup
    EnableShortCut()
End Sub

Sub A1()
    MsgBox "A1"
End Sub

Sub A2()
    MsgBox "A2"
End Sub

Sub A3()
    MsgBox "A3"
End Sub

Public Sub EnableShortCut()
    With Application
        .OnKey "+^{U}", "A1"  'action A1 should be performed when user clicks  Ctrl + Shift + U
        .OnKey "+^{L}", "A2"  'action A2 should be performed when user clicks  Ctrl + Shift + L
        .OnKey "+^{P}", "A3"  'action A3 should be performed when user clicks  Ctrl + Shift + P
    End With
End Sub

End Class

The Add-In when installed shows an error on clicking the short cuts. It says the specific macro cannot be found. The code under the Sub EnableShortCut() works well when it is in an excel vba module. The same won't work when it is added to an Excel Add-In created with Visual Studio. Some one out there please help me to resolve this issue.

Answer 1

"I would like to run some code when users presses a combination of keys."

Its tricky and to do it without any external dependencies resort to Keyboard hooking to achieve it with a VSTO Excel Add-in:

Imports System
Imports System.Runtime.CompilerServices
Imports System.Runtime.InteropServices
Imports System.Windows.Forms

Friend Class KeyboardHooking
    ' Methods
    <DllImport("user32.dll", CharSet:=CharSet.Auto, SetLastError:=True)> _
    Private Shared Function CallNextHookEx(ByVal hhk As IntPtr, ByVal nCode As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As IntPtr
    End Function

    <DllImport("kernel32.dll", CharSet:=CharSet.Auto, SetLastError:=True)> _
    Private Shared Function GetModuleHandle(ByVal lpModuleName As String) As IntPtr
    End Function

    Private Shared Function HookCallback(ByVal nCode As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As Integer
        If ((nCode >= 0) AndAlso (nCode = 0)) Then
            Dim keyData As Keys = DirectCast(CInt(wParam), Keys)
            If (((BindingFunctions.IsKeyDown(Keys.ControlKey) AndAlso BindingFunctions.IsKeyDown(Keys.ShiftKey)) AndAlso BindingFunctions.IsKeyDown(keyData)) AndAlso (keyData = Keys.D7)) Then
'DO SOMETHING HERE
            End If
            If ((BindingFunctions.IsKeyDown(Keys.ControlKey) AndAlso BindingFunctions.IsKeyDown(keyData)) AndAlso (keyData = Keys.D7)) Then
'DO SOMETHING HERE
            End If
        End If
        Return CInt(KeyboardHooking.CallNextHookEx(KeyboardHooking._hookID, nCode, wParam, lParam))
    End Function

    Public Shared Sub ReleaseHook()
        KeyboardHooking.UnhookWindowsHookEx(KeyboardHooking._hookID)
    End Sub

    Public Shared Sub SetHook()
        KeyboardHooking._hookID = KeyboardHooking.SetWindowsHookEx(2, KeyboardHooking._proc, IntPtr.Zero, Convert.ToUInt32(AppDomain.GetCurrentThreadId))
    End Sub

    <DllImport("user32.dll", CharSet:=CharSet.Auto, SetLastError:=True)> _
    Private Shared Function SetWindowsHookEx(ByVal idHook As Integer, ByVal lpfn As LowLevelKeyboardProc, ByVal hMod As IntPtr, ByVal dwThreadId As UInt32) As IntPtr
    End Function

    <DllImport("user32.dll", CharSet:=CharSet.Auto, SetLastError:=True)> _
    Private Shared Function UnhookWindowsHookEx(ByVal hhk As IntPtr) As <MarshalAs(UnmanagedType.Bool)> Boolean
    End Function


    ' Fields
    Private Shared _hookID As IntPtr = IntPtr.Zero
    Private Shared _proc As LowLevelKeyboardProc = New LowLevelKeyboardProc(AddressOf KeyboardHooking.HookCallback)
    Private Const WH_KEYBOARD As Integer = 2
    Private Const WH_KEYBOARD_LL As Integer = 13
    Private Const WM_KEYDOWN As Integer = &H100

    ' Nested Types
    Public Delegate Function LowLevelKeyboardProc(ByVal nCode As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As Integer
End Class

Public Class BindingFunctions
    ' Methods
    <DllImport("user32.dll")> _
    Private Shared Function GetKeyState(ByVal nVirtKey As Integer) As Short
    End Function

    Public Shared Function IsKeyDown(ByVal keys As Keys) As Boolean
        Return ((BindingFunctions.GetKeyState(CInt(keys)) And &H8000) = &H8000)
    End Function

End Class

C# version - the original that the above vb.net code was converted from - but I had to use Reflector as CodeConverter & devfusion didn't do it correctly.

class KeyboardHooking
{
[DllImport("user32.dll", CharSet = CharSet.Auto, SetLastError = true)]
private static extern IntPtr SetWindowsHookEx(int idHook, LowLevelKeyboardProc lpfn, IntPtr hMod,
    uint dwThreadId);

[DllImport("user32.dll", CharSet = CharSet.Auto, SetLastError = true)]
[return: MarshalAs(UnmanagedType.Bool)]
private static extern bool UnhookWindowsHookEx(IntPtr hhk);

[DllImport("user32.dll", CharSet = CharSet.Auto, SetLastError = true)]
private static extern IntPtr CallNextHookEx(IntPtr hhk, int nCode, IntPtr wParam, IntPtr lParam);

[DllImport("kernel32.dll", CharSet = CharSet.Auto, SetLastError = true)]
private static extern IntPtr GetModuleHandle(string lpModuleName);

public delegate int LowLevelKeyboardProc(int nCode, IntPtr wParam, IntPtr lParam);
private static LowLevelKeyboardProc _proc = HookCallback;
private static IntPtr _hookID = IntPtr.Zero;

//declare the mouse hook constant.
//For other hook types, you can obtain these values from Winuser.h in the Microsoft SDK.

private const int WH_KEYBOARD = 2; // mouse
private const int HC_ACTION = 0;

private const int WH_KEYBOARD_LL = 13; // keyboard
private const int WM_KEYDOWN = 0x0100;

public static void SetHook()
{
    // Ignore this compiler warning, as SetWindowsHookEx doesn't work with ManagedThreadId
    #pragma warning disable 618
    _hookID = SetWindowsHookEx(WH_KEYBOARD, _proc, IntPtr.Zero, (uint)AppDomain.GetCurrentThreadId());
    #pragma warning restore 618

}

public static void ReleaseHook()
{
    UnhookWindowsHookEx(_hookID);
}

//Note that the custom code goes in this method the rest of the class stays the same.
//It will trap if BOTH keys are pressed down.
private static int HookCallback(int nCode, IntPtr wParam, IntPtr lParam)
{
    if (nCode < 0)
    {
        return (int)CallNextHookEx(_hookID, nCode, wParam, lParam);
    }
    else
    {

        if (nCode == HC_ACTION)
        {
            Keys keyData = (Keys)wParam;

            // CTRL + SHIFT + 7
            if ((BindingFunctions.IsKeyDown(Keys.ControlKey) == true)
                && (BindingFunctions.IsKeyDown(Keys.ShiftKey) == true)
                && (BindingFunctions.IsKeyDown(keyData) == true) && (keyData == Keys.D7))
            {
                // DO SOMETHING HERE
            }

            // CTRL + 7
            if ((BindingFunctions.IsKeyDown(Keys.ControlKey) == true)
                && (BindingFunctions.IsKeyDown(keyData) == true) && (keyData == Keys.D7))
            {
                // DO SOMETHING HERE
            }



        }
        return (int)CallNextHookEx(_hookID, nCode, wParam, lParam);
    }
}
}

public class BindingFunctions
{
[DllImport("user32.dll")]
static extern short GetKeyState(int nVirtKey);

public static bool IsKeyDown(Keys keys)
{
    return (GetKeyState((int)keys) & 0x8000) == 0x8000;
}

}

You'll need to put code in the HookCallback() method in the above code to trap events when key combinations are pressed, I've given you two examples Ctrl + Shift + 7 and Ctrl + 7 to get you going.

Then in your Excel AddIn wire it up:

Private Sub ThisAddIn_Startup() Handles Me.Startup

'enable keyboard intercepts
KeyboardHooking.SetHook()

And dont forget to disable it when your done:

Private Sub ThisAddIn_Shutdown() Handles Me.Shutdown

'disable keyboard intercepts
KeyboardHooking.ReleaseHook()