miércoles, 23 de mayo de 2018

VBA Access. Módulo para substituir SendKeys usando el API de Windows para evitar el conocido bug de SendKeys con el NumLock.

Option Compare Database
Option Explicit

'Ej tecla ESCAPE: EnviarTeclas VK_ESCAPE
'Ej tecla ESCAPE 2 veces: EnviarTeclas VK_ESCAPE , , 2
'Ej teclas CTRL+C: EnviarTeclas VK_CONTROL,vbKeyC
'Ej teclas ALT+SPACE: EnviarTeclas VK_MENU,VK_SPACE
'Ej teclas ALT+G: EnviarTeclas VK_MENU, vbKeyG
'Ej teclas SHIFT+DEL: EnviarTeclas VK_SHIFT, VK_DELETE

Const KEYEVENTF_KEYUP = &H2
Const KEYEVENTF_EXTENDEDKEY = &H1

'-----------------
'Virtual Key Codes
'-----------------

'VK_LBUTTON The left mouse button
'VK_RBUTTON The right mouse button
'VK_CANCEL The Cancel virtual key, used for control-break processing
'VK_MBUTTON The middle mouse button
'VK_BACK Backspace
'VK_TAB Tab
'VK_CLEAR 5 (keypad without Num Lock)
'VK_RETURN Enter
'VK_SHIFT Shift (either one)
'VK_CONTROL Ctrl (either one)
'VK_MENU Alt (either one)
'VK_PAUSE Pause
'VK_CAPITAL Caps Lock
'VK_ESCAPE Esc
'VK_SPACE Spacebar
'VK_PRIOR Page Up
'VK_NEXT Page Down
'VK_END End
'VK_HOME Home
'VK_LEFT Left Arrow
'VK_UP Up Arrow
'VK_RIGHT Right Arrow
'VK_DOWN Down Arrow
'VK_SELECT Select
'VK_PRINT Print (only used by Nokia keyboards)
'VK_EXECUTE Execute (Not used)
'VK_SNAPSHOT Print Screen
'VK_INSERT Insert
'VK_DELETE Delete
'VK_HELP Help

'Constant Definitions

Public Const VK_LBUTTON = &H1
Public Const VK_RBUTTON = &H2
Public Const VK_CANCEL = &H3
Public Const VK_MBUTTON = &H4
Public Const VK_BACK = &H8
Public Const VK_TAB = &H9
Public Const VK_CLEAR = &HC
Public Const VK_RETURN = &HD
Public Const VK_SHIFT = &H10
Public Const VK_CONTROL = &H11
Public Const VK_MENU = &H12
Public Const VK_PAUSE = &H13
Public Const VK_CAPITAL = &H14
Public Const VK_ESCAPE = &H1B
Public Const VK_SPACE = &H20
Public Const VK_PRIOR = &H21
Public Const VK_NEXT = &H22
Public Const VK_END = &H23
Public Const VK_HOME = &H24
Public Const VK_LEFT = &H25
Public Const VK_UP = &H26
Public Const VK_RIGHT = &H27
Public Const VK_DOWN = &H28
Public Const VK_SELECT = &H29
Public Const VK_PRINT = &H2A
Public Const VK_EXECUTE = &H2B
Public Const VK_SNAPSHOT = &H2C
Public Const VK_INSERT = &H2D
Public Const VK_DELETE = &H2E
Public Const VK_HELP = &H2F

#If Win64 = 1 Then
    Private Declare PtrSafe Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
#Else
    Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
#End If

#If Win64 = 1 Then
    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) 'For 64 Bit Systems
#Else
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'For 32 Bit Systems
#End If

Public Function EnviarTeclas(Key1 As Long, Optional Key2 As Long = 0, Optional NumRepeticiones = 1) As Boolean
On Error GoTo error
    Dim i As Integer
 
    For i = 1 To NumRepeticiones
        Call keybd_event(Key1, 0, 0, 0)
        If Key2 <> 0 Then Call keybd_event(Key2, 0, 0, 0)
     
        Sleep 10
        DoEvents
     
        Call keybd_event(Key1, 0, KEYEVENTF_KEYUP, 0)
        If Key2 <> 0 Then Call keybd_event(Key2, 0, KEYEVENTF_KEYUP, 0)
     
        Sleep 10
        DoEvents
    Next i
 
    EnviarTeclas = True
 
Exit Function
error:
    Debug.Print Err.Number & ": " & Err.Description
    EnviarTeclas = False
End Function

No hay comentarios:

Publicar un comentario

VBA Access. Redondeo de números decimales con el método medio redondeo. Alternativa a la función Round (bankers round)

 Private Function Redondeo(ByVal Numero As Variant, ByVal Decimales As Integer) As Double     'Aplica método medio redondeo (half round ...