[VBA]xl*-Utiliser F1...F12 dans un form

Youki content !
Grâce à la méritoire et persévérante aide de DarkVader, sur VBA97 ça marche aussi (enfin) !
(Non non, je n'ai pas oublié Tofalu, Ridan, Arquebuse, et tous les autres...)

Donc, je cherchais (en avril 1997) à tester les touches F1-F12 dans un form avec VBA97... :wink:

Dans un module :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
Public ghwnd As Long, kHwnd As Long, uId As Long, fin As Boolean
Declare Function SetTimer Lib "user32" (ByVal ghwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Declare Function KillTimer Lib "user32" (ByVal kHwnd As Long, ByVal nIDEvent As Long) As Long
Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
 
Sub OpenTheForm()
    Load UserForm1
    UserForm1.Show
    ArrêterTimer
End
End Sub
 
Sub GetPressedKey()
Dim ok(12) As Boolean, j As Integer, i As Integer
    touche = Array("", "F1", "F2", "F3", "F4", "F5", "F6", "F7", "F8", "F9", "F10", "F11", "F12")
    ok(1) = GetAsyncKeyState(112) <> 0
    ok(2) = GetAsyncKeyState(113) <> 0
    ok(3) = GetAsyncKeyState(114) <> 0
    ok(4) = GetAsyncKeyState(115) <> 0
    ok(5) = GetAsyncKeyState(116) <> 0
    ok(6) = GetAsyncKeyState(117) <> 0
    ok(7) = GetAsyncKeyState(118) <> 0
    ok(8) = GetAsyncKeyState(119) <> 0
    ok(9) = GetAsyncKeyState(120) <> 0
    ok(10) = GetAsyncKeyState(121) <> 0
    ok(11) = GetAsyncKeyState(122) <> 0
    ok(12) = GetAsyncKeyState(123) <> 0
    Sleep 100
    ok(0) = ok(1) + ok(2) + ok(3) + ok(4) + ok(5) + ok(6) + ok(7) + ok(8) + ok(9) + ok(10) + ok(11) + ok(12)
    If ok(0) Then
        For i = 1 To 12
            If ok(i) Then
                For j = 1 To 5
                    Beep
                Next j
                UserForm1.Label1.Caption = "Touche frappée : " & touche(i)
                Exit For
            End If
        Next
    End If
End Sub
 
Sub ArrêterTimer()
    KillTimer kHwnd, uId
End Sub

Dans le form, et pour le test, un bouton "Quitter", un label où sera affiché le nom de la touche frappée

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Private Declare Function GetCurrentVbaProject Lib "vba332.dll" Alias "EbGetExecutingProj" (hProject As Long) As Long
Private Declare Function GetFuncID Lib "vba332.dll" Alias "TipGetFunctionId" (ByVal hProject As Long, ByVal strFunctionName As String, ByRef strFunctionID As String) As Long
Private Declare Function GetAddr Lib "vba332.dll" Alias "TipGetLpfnOfFunctionId" (ByVal hProject As Long, ByVal strFunctionID As String, ByRef lpfn As Long) As Long
 
Private Sub UserForm_Activate()
    If Val(Application.Version) < 9 Then
            uId = SetTimer(ghwnd, 0, 1, AddressOf97("GetPressedKey"))
        Else
            'SetTimer ghwnd, 0, 1, AddressOf GetPressedKey
    End If
End Sub
 
Function AddressOf97(sFunctionName As String) As Long
    Dim lResult As Long, lCurrentVBProject As Long, sFunctionID As String, lAddressOfFunction As Long, sFunctionUniCode As String
 
    sFunctionUniCode = StrConv(sFunctionName, vbUnicode)
 
    If GetCurrentVbaProject(lCurrentVBProject) <> 0 Then
        lResult = GetFuncID(lCurrentVBProject, sFunctionUniCode, sFunctionID)
        If lResult = 0 Then
            lResult = GetAddr(lCurrentVBProject, sFunctionID, lAddressOfFunction)
            If lResult = 0 Then AddressOf97 = lAddressOfFunction
        End If
    End If
End Function
 
Private Sub BoutonQuitter_Click()
    Unload UserForm1
End Sub

Épicétou

Donc, merci à tous ceux qui, dans leur grande magnanimité, ont accepté de m'aider, de me guider, de m'accompagner, de me soutenir... et sans lesquels je ne serais arrivé à rien :cry:

:merci: :lahola: :merci:

Edit
Relisant tout par le menu, j'ai retrouvé ça :

Citation:

Arf c'est dommage de tagguer delestage .. il sera supprimer alors que pas mal de pistes ont étaient évoquées .. tu préferes pas qu'on le garde pour plus tard ?

Tu vois, Tofalu, j'ai suivi ton conseil du ... 14 septembre :lol:

Edit 2
Je viens de m'apercevoir que j'avais deux variables pour KillTimer, nIDEvent et uId. Dommage, ça marche ainsi mais ce serait mieux avec une seule, non ?

Edit 3
Oui ! Et puis la déclaration

Citation:

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

ne sert plus à rien...