Working with the Keyboard
The behavior of many of Excel's toolbar buttons and some of the dialog buttons changes if the Shift key is held down when the button is clicked. For example, the Increase decimal toolbar button normally increases the number of decimal places shown in a cell, but decreases the number of decimal places if it is clicked with the Shift key held down. Similarly, when closing Excel, if you hold down the Shift key when clicking the No button on the Save Changes? dialog, it acts like a "No to All" button. We can do exactly the same in our applications by using API functions to examine the state of the keyboard. The procedures included in this section can be found in the MKeyboard module of the API Examples.xls workbook.
Checking for Shift, Ctrl, Alt, Caps Lock, Num Lock and Scroll Lock
The GetKeyState API function tells us whether a given key on the keyboard is currently held down or "on" (in the case of Caps Lock, Num Lock and Scroll Lock). The function is used by passing a code representing the key we're interested in and returns whether the key is being held down or is "on." Listing 9-8 shows a function to determine whether one of the six "special" keys is currently pressed. Note that we have again encapsulated the key code constants inside a more meaningful enumeration.
Listing 9-8 Checking Whether a Key Is Held Down
Private Declare Function GetKeyState Lib "user32" _ (ByVal vKey As Long) As Integer Private Const VK_SHIFT As Long = &H10 Private Const VK_CONTROL As Long = &H11 Private Const VK_MENU As Long = &H12 Private Const VK_CAPITAL = &H14 Private Const VK_NUMLOCK = &H90 Private Const VK_SCROLL = &H91 Public Enum GetKeyStateKeyboardCodes gksKeyboardShift = VK_SHIFT gksKeyboardCtrl = VK_CONTROL gksKeyboardAlt = VK_MENU gksKeyboardCapsLock = VK_CAPITAL gksKeyboardNumLock = VK_NUMLOCK gksKeyboardScrollLock = VK_SCROLL End Enum Public Function IsKeyPressed _ (ByVal lKey As GetKeyStateKeyboardCodes) As Boolean Dim iResult As Integer iResult = GetKeyState(lKey) Select Case lKey Case gksKeyboardCapsLock, gksKeyboardNumLock, _ gksKeyboardScrollLock 'For the three 'toggle' keys, the 1st bit says if it's 'on or off, so clear any other bits that might be set, 'using a binary AND iResult = iResult And 1 Case Else 'For the other keys, the 16th bit says if it's down or 'up, so clear any other bits that might be set, using a 'binary AND iResult = iResult And &H8000 End Select IsKeyPressed = (iResult <> 0) End Function
The value obtained from the call to GetKeyState should not be interpreted as a simple number, but as its binary representation where each individual bit represents whether a particular attribute is on or off. This is one of the few functions that return a 16-bit Integer value, rather than the more common 32-bit Long. The MSDN documentation for GetKeyState says that "If the high-order bit is 1, the key is down, otherwise the key is up. If the low-order bit is 1, the key is on, otherwise the key is off." The first sentence is applicable for all keys (down/up), whereas the second is only applicable to the Caps Lock, Num Lock and Scroll Lock keys. It is possible for both bits to be set, if the Caps Lock key is held down and "on." The low-order bit is the rightmost bit, and the high-order bit is the leftmost (16th) bit. To examine whether a specific bit has been set, we have to apply a bit mask, to zero-out the bits we're not interested in, by performing a binary AND between the return value and a binary value that has a single 1 in the position we're interested in. In the first case, we're checking for a 1 in the first bit, which is the number 1. In the second case, we're checking for a 1 in the 16th bit, i.e. the binary number 1000 0000 0000 0000, which is easiest to represent in code as the hexadecimal number &h8000. After we've isolated that bit, a zero value means off/up and a nonzero value means on/down.
Testing for a Key Press
As mentioned previously, at the lowest level, windows communicate through messages sent to their wndproc procedure. When an application is busy (such as Excel running some code), the wndproc only processes critical messages (such as the system shutting down). All other messages get placed in a queue and are processed when the application next has some spare time. This is why using SendKeys is so unreliable; it's not until the code stops running (or issues a DoEvents statement) that Excel checks its message queue to see whether there are any key presses to process.
We can use Excel's message queuing to allow the user to interrupt our code by pressing a key. Normally, if we want to allow the user to stop a lengthy looping process, we can either show a modeless dialog with a Cancel button (as explained in Chapter 10 Userform Design and Best Practices), or allow the user to press the Cancel key to jump into the routine's error handler (as explained in Chapter 12 VBA Error Handling). An easier way is to check Excel's message queue during each iteration of the loop to see whether the user has pressed a key. This is achieved using the PeekMessage API function:
Declare Function PeekMessage Lib "user32" _ Alias "PeekMessageA" _ (ByRef lpMsg As MSG, _ ByVal hWnd As Long, _ ByVal wMsgFilterMin As Long, _ ByVal wMsgFilterMax As Long, _ ByVal wRemoveMsg As Long) As Long
If you look at the first parameter of the PeekMessage function, you'll see it is declared As MSG and is passed ByRef. MSG is a windows structure and is implemented in VBA as a user-defined type. To use it in this case, we declare a variable of that type and pass it in to the function. The function sets the value of each element of the UDT, which we then read. Many API functions use structures as a convenient way of passing large amounts of information into the function, instead of having a long list of parameters. Many messages that we send using the SendMessage function require a structure to be passed as the final parameter (as opposed to a single Long value). In those cases, we use a different form of the SendMessage declaration, where the final parameter is declared As Any and is passed ByRef:
Declare Function SendMessageAny Lib "user32" _ Alias "SendMessageA" _ (ByVal hwnd As Long, ByVal wMsg As Long, _ ByVal wParam As Long, _ ByRef lParam As Any) As Long
When we use this declaration, we're actually sending a pointer to the memory where our UDT is stored. If we have an error in the definition of our UDT, or if we use this version of the declaration to send a message that is not expecting a memory pointer, the call will at best fail and possibly crash Excel.
Listing 9-9 shows the full code to check for a key press.
Listing 9-9 Testing for a Key Press
'Type to hold the coordinates of the mouse pointer Private Type POINTAPI x As Long y As Long End Type 'Type to hold the Windows message information Private Type MSG hWnd As Long 'the window handle of the app message As Long 'the type of message (e.g. keydown) wParam As Long 'the key code lParam As Long 'not used time As Long 'time when message posted pt As POINTAPI 'coordinate of mouse pointer End Type 'Look in the message buffer for a message Private Declare Function PeekMessage Lib "user32" _ Alias "PeekMessageA" _ (ByRef lpMsg As MSG, ByVal hWnd As Long, _ ByVal wMsgFilterMin As Long, _ ByVal wMsgFilterMax As Long, _ ByVal wRemoveMsg As Long) As Long 'Translate the message from a key code to a ASCII code Private Declare Function TranslateMessage Lib "user32" _ (ByRef lpMsg As MSG) As Long 'Windows API constants Private Const WM_CHAR As Long = &H102 Private Const WM_KEYDOWN As Long = &H100 Private Const PM_REMOVE As Long = &H1 Private Const PM_NOYIELD As Long = &H2 'Check for a key press Public Function CheckKeyboardBuffer() As String 'Dimension variables Dim msgMessage As MSG Dim hWnd As Long Dim lResult As Long 'Get the window handle of this application hWnd = ApphWnd 'See if there are any "Key down" messages lResult = PeekMessage(msgMessage, hWnd, WM_KEYDOWN, _ WM_KEYDOWN, PM_REMOVE + PM_NOYIELD) 'If so ... If lResult <> 0 Then '... translate the key-down code to a character code, 'which gets put back in the message queue as a WM_CHAR 'message ... lResult = TranslateMessage(msgMessage) '... and retrieve that WM_CHAR message lResult = PeekMessage(msgMessage, hWnd, WM_CHAR, _ WM_CHAR, PM_REMOVE + PM_NOYIELD) 'Return the character of the key pressed, 'ignoring shift and control characters CheckKeyboardBuffer = Chr$(msgMessage.wParam) End If End Function
When we press a key on the keyboard, the active window is sent a WM_KEYDOWN message, with a low-level code to identify the physical key pressed. The first thing we need to do, then, is to use PeekMessage to look in the message queue to see whether there are any pending WM_KEYDOWN messages, removing it from the queue if we find one. If we found one, we have to translate it into a character code using TranslateMessage, which sends the translated message back to Excel's message queue as a WM_CHAR message. We then look in the message queue for this WM_CHAR message and return the character pressed.