Hola:
Pues bien hace poco hice este código a ver que les parece.
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Label1 = KeyCode
Label2 = "Se Conoce Como: " & TeclaPresionada(KeyCode)
End Sub
Private Sub Form_Load()
Me.KeyPreview = True
End Sub
Private Function TeclaPresionada(Tecla As Integer) As String
Select Case Tecla
Case 8: TeclaPresionada = "Retroceso"
Case 9: TeclaPresionada = "Tab"
Case 13: TeclaPresionada = "Entrada"
Case 16: TeclaPresionada = "Shift"
Case 17: TeclaPresionada = "Control"
Case 18: TeclaPresionada = "Alt"
Case 19: TeclaPresionada = "Pausa"
Case 20: TeclaPresionada = "Mayus"
Case 23: TeclaPresionada = "Entrada"
Case 27: TeclaPresionada = "Escape"
Case 32: TeclaPresionada = "Barra Espaciadora"
Case 33: TeclaPresionada = "Re Pag"
Case 34: TeclaPresionada = "Av PAg"
Case 35: TeclaPresionada = "Fin"
Case 36: TeclaPresionada = "Shift"
Case 37: TeclaPresionada = "Flecha Izq"
Case 38: TeclaPresionada = "Flecha Arriba"
Case 39: TeclaPresionada = "Flecha Der"
Case 40: TeclaPresionada = "Flecha Abajo"
Case 45: TeclaPresionada = "Insert"
Case 46: TeclaPresionada = "Supr"
Case 48 To 57: TeclaPresionada = AbNumero(Tecla - 47)
Case 65 To 90: TeclaPresionada = ABCDario(Tecla - 64, AbMayus)
Case 91, 92: TeclaPresionada = "Windows"
Case 96 To 105: TeclaPresionada = AbNumero(Tecla - 95) & " Tec Numerico"
Case 106: TeclaPresionada = "*"
Case 107: TeclaPresionada = "+"
Case 109: TeclaPresionada = "-"
Case 110: TeclaPresionada = "."
Case 111: TeclaPresionada = "÷"
Case 112 To 123: TeclaPresionada = "F" & Tecla - 111
Case 144: TeclaPresionada = "Bloq Num"
Case 144: TeclaPresionada = "Bloq Despl"
Case 186 To 192: TeclaPresionada = AbEspecial(Tecla - 185)
Case 219: TeclaPresionada = "?"
Case 220: TeclaPresionada = "°"
Case 221: TeclaPresionada = "¡"
Case 222: TeclaPresionada = "["
Case Else: TeclaPresionada = "Desconocido"
End Select
End Function
' Y en un módulo peguen lo siguiente
Public Enum AbMinMay
AbMinus
AbMayus
End Enum
Public Function ABCDario(AbLetra As Integer, AbMinsMays As AbMinMay) As String
Dim CadABCMay, CadABCMin As String
CadABCMay = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
CadABCMin = LCase$(CadABCMay)
If AbLetra < 1 Then
MsgBox "AbLetra < 1"
ElseIf AbLetra > 26 Then
MsgBox "AbLetra < 26"
Else
Select Case AbMinsMays
Case AbMayus: ABCDario = Mid(CadABCMay, AbLetra, 1)
Case AbMinus: ABCDario = Mid(CadABCMin, AbLetra, 1)
End Select
End If
End Function
Public Function AbNumero(AbNum As Integer) As String
Dim CadNum As String
CadNum = "0123456789"
If AbNum < 1 Or AbNum > 10 Then
MsgBox "La cadena de AbNum debe ser entre 1 y 10"
Else
AbNumero = Mid(CadNum, AbNum, 1)
End If
End Function
Public Function AbEspecial(AbNum As Integer) As String
Dim CadNum As String
CadNum = "´+;-:}Ñ"
If AbNum < 1 Or AbNum > 7 Then
MsgBox "La cadena de AbNum debe ser entre 1 y 7"
Else
AbEspecial = Mid(CadNum, AbNum, 1)
End If
End Function
' Saludos
