Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

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

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.

like image 539
Kannan Suresh Avatar asked Apr 17 '12 14:04

Kannan Suresh


3 Answers

"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()
like image 120
Jeremy Thompson Avatar answered Nov 15 '22 21:11

Jeremy Thompson


Using Excel-DNA (an open source .NET / Excel integration library that I develop) the methods and user-defined functions in your .NET code are registered with Excel through the C API. As a result the behaviour is closer to that of VBA, and your code with the Application.OnKey "..." strings would work too.

Excel-DNA allows your code to be in a compiled .NET .dll assembly or directly as text in a '.dna' file which is processed when you load the add-in. Here is an example of a such a text file (the code would look the same if it were in a compiled project). As mentioned in one of the other answers, I have renamed the macros so their names don't clash with the cell names A1 etc.

To make an add-in

  1. save the code as a text file called OnKeyTest.dna, and
  2. match it with a copy of the Excel-DNA host library ExcelDna.xll from the release on CodePlex, which you just copy and rename to OnKeyTest.xll (the matching name is how the .dna file is found when you load the .xll).

These two file would form your complete add-in, just needing .NET on the machine to run.

<DnaLibrary Language="VB" RuntimeVersion="v2.0" >
<![CDATA[
Imports ExcelDna.Integration

Public Class MyAddIn
    Implements IExcelAddIn

    Private Sub AutoOpen() Implements IExcelAddIn.AutoOpen
        EnableShortCut()
    End Sub

    Private Sub AutoClose() Implements IExcelAddIn.AutoClose
    End Sub

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

Public Module MyMacros
    Sub MacroA1()
        MsgBox("A1")
    End Sub

    Sub MacroA2()
        MsgBox("A2")
    End Sub

    Sub MacroA3()
        MsgBox("A3")
    End Sub
End Module
]]>
</DnaLibrary>
like image 32
Govert Avatar answered Nov 15 '22 20:11

Govert


This is difficult to do, the Application.OnKey() method is very restricted. It can only call a macro and cannot pass any arguments. Which means that you'll have to provide a set of macros. You don't want workbook specific ones, you need macros that work in any document. Let's tackle that first.

  • Start Excel and use File + Close to close the default workbook
  • Click Record macro. Change the "Store macro in" setting to Personal Macro Workbook
  • OK to close the dialog and click Stop Recording
  • Click Visual Basic. Note that you've now got a VBA project named PERSONAL.XLSB with a Module1

Delete Macro1 and copy/paste this VBA code:

Sub MyAddinCommand1()
  Application.COMAddIns("ExcelAddin1").Object.Command 1
End Sub

Sub MyAddinCommand2()
  Application.COMAddIns("ExcelAddin1").Object.Command 2
End Sub

Sub MyAddinCommand3()
  Application.COMAddIns("ExcelAddin1").Object.Command 3
End Sub

Repeat as often as necessary, you want one for each shortcut key you want to define. Click Save. You now created a file in c:\users\yourname\appdata\roaming\microsoft\excel\xlstart\personal.xlsb that contains the macros. Anybody that is going to use your extension needs to have this file as well, a deployment detail.

Next thing you need to do is expose your commands. The Sub A1() you wrote in the addin will not do, the methods need to be exposed as methods of a COM visible class. Add a new class to your project and make the code look like this:

Imports System.Runtime.InteropServices

<InterfaceType(Runtime.InteropServices.ComInterfaceType.InterfaceIsIDispatch)> _
<ComVisible(True)> _
Public Interface IMyAddinCommand
    Sub Command(ByVal index As Integer)
End Interface

<ClassInterface(Runtime.InteropServices.ClassInterfaceType.None)> _
<ComVisible(True)> _
Public Class MyAddinCommand
    Implements IMyAddinCommand

    Public Sub Command(index As Integer) Implements IMyAddinCommand.Command
        MsgBox("Command #" + CStr(index))
    End Sub
End Class

Just a simple one that exposes a single method named Command() that takes an integer. I'm just used MsgBox, you'll want to write a Select statement to implement the command based on the value of index. Also note the match with the code in the global macro.

One more thing you need to do, you must expose this class explicitly. Override the RequestComAddInAutomationService function in your addin. The one I used to test this looked like this:

Public Class ThisAddIn

    Private Sub ThisAddIn_Startup() Handles Me.Startup
        Application.OnKey("+^{U}", "Personal.xlsb!MyAddinCommand1")  '' Ctrl + Shift + U
    End Sub

    Protected Overrides Function RequestComAddInAutomationService() As Object
        If commands Is Nothing Then commands = New MyAddinCommand
        Return commands
    End Function

    Private commands As MyAddinCommand

End Class

Press F5 to compile and start Excel. When I press Ctrl+Shift+U I get this:

enter image description here

like image 29
Hans Passant Avatar answered Nov 15 '22 20:11

Hans Passant