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

Version imprimable

Voir 40 message(s) de cette discussion en une page

07/09/2005, 16h04
ouskel'n'or

Citation:

ensuite tu verras que si tu appuies longtemps sur F1, il y a un effet de répétition A voir comment le stopper

Là, Tofalu, en jouant avec les codes des touches, j'ai trouvé :

Code:

SendKeys "{ESC}", True

une fois le code de la touche à tester, testé... :wink:

Je n'ai plus de répétition, c'est un bon début. J'avais ça, j'ai plus...

A+
07/09/2005, 16h10
ouskel'n'or

Gentil, Ridan, gentil !

Et merci

A+

PS - Pense que je suis sur office 97 s'il te plait, please...
08/09/2005, 18h00
ridan

Salut esc.... euuhh ouskel'n'or :lol:

http://j-walk.com/ss/excel/tips/tip44.htm

Il ne reste plus qu'à adapter cette astuce à tes besoins ... non ?? ;)
12/09/2005, 10h02
ouskel'n'or

Hello Ridan,

Merci.
Je suis allé sur l'URL que tu m'as donné... Suspens !
Est-ce la bonne solution ?
Avec les boutons...

ÇA MARCHE !

Comme tu dis, reste plus qu'à adapter, ce qui ne devrait pas poser trop de problème.

En associant la méthode de Starec, consistant à créer une collection de contrôles comportant tous le même préfixe dans le nom (méthode heureusement adoptée à la construction de mon appli, il y a quatre ans), au code fourni par l'URL, et en ajoutant quelques bricoles (déjà réalisées) afin d'identifier les touches F1...F12, je devrais pouvoir m'en sortir.

Je réalise et dès que c'est fini, j'affiche...

A +
12/09/2005, 16h57
ouskel'n'or

Hello,
C'est re-moi... :cry: Je savais bien que ça ne pouvait pas être aussi simple :
Avec office 97 (je ne sais pas sur les versions ultérieures) les Text, combo, list... box, n'acceptent pas "Automation"...

Citation:

L'objet n'est pas source d'événement automation

Je vais attaquer les 250 lignes de code fourni par Bidou sur un autre post.

Je reviendrai sûrement... :cry:

A+
12/09/2005, 16h58
ridan

salut,

Est-il possible d'avoir un bout du code qui génère l'erreur stp :?: :?:

:)

Donc, dans un module de class, j'ai

Code:

1
2
3
4
5
Public WithEvents TextGroup As Controls
 
Private Sub TextGroup_Click()
    MsgBox "Hello from " & TextGroup.Name
End Sub

puis, dans un module, pour ouvrir le form, j'ai

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Option Explicit
Dim BoiteText() As New Class1
 
Sub ShowDialog()
    Dim TextCount As Integer
    Dim ctl As Control
    Dim ok As Boolean
    TextCount = 1
    For Each ctl In UserForm1.Controls
        ok = InStr(ctl.Name, "Text") <> 0
        If ok Then
                TextCount = TextCount + 1
                ReDim Preserve BoiteText(1 To TextCount)
                Set BoiteText(TextCount).TextGroup = ctl
        End If
    Next ctl
    UserForm1.Show
End Sub

Dans le form, certains contrôles ont un nom contenant "Text" d'où la modif par rapport au code d'origine

Si tu trouves un bêtise, ne sois pas trop sévère... j'ai déjà le moral par terre... :cry:

A+ et merci de ton opiniâtreté

12/09/2005, 17h13
ouskel'n'or

PS - L'erreur est sur la ligne

Code:

Set BoiteText(TextCount).TextGroup = ctl
14/09/2005, 16h54
ouskel'n'or

Hello, en fait de Truc et astuce, c'est réussi ! :cry:

Je vais certainement décevoir les 350 et quelques visiteurs de la question, mais, au moins provisoirement, je renonce.
Je n'ai pas réussi à comprendre ce que les 250 lignes citées plus haut étaient censées me faire faire... :bug: alors, pour le moment, je vais délester.

Je remercie tous ceux qui ont tenté d'aider le pauv' ignare que je suis, Bidou, Ridan, Tofalu, Xo, mais aussi Alcool90° grâce auquel je vais pouvoir noyer mon chagrin... :wow:

Mais je reviendrai :traine:

A+
14/09/2005, 17h00
Tofalu

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 ?

Salut,

Désolé pour ma réponse tardive :oops: j'ai pas eu le temps de me pencher sur ce problème ...

Bon voilà pour ton erreur, je crois que c'est du fait qu'une instance de la classe control ne peut pas contenir un objet d'un autre type .... enfin je crois :aie:

Pour le moment, le mieux à faire serait une manip du genre :

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
Public WithEvents lbl As MSForms.Label
Public WithEvents Tox As MSForms.TextBox
Public WithEvents Lst As MSForms.ListBox
Public WithEvents cmd As MSForms.CommandButton
Public WithEvents Opt As MSForms.OptionButton
Public WithEvents cmb As MSForms.ComboBox
 
Private Sub lbl_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    MsgBox "Hello from Lbl"
End Sub
 
 
Private Sub Tox_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    MsgBox "Hello from Txt"
End Sub
 
 
Private Sub cmd_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    MsgBox "Hello from cmd"
End Sub
 
Private Sub Opt_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    MsgBox "Hello from Opt"
End Sub
 
 
Private Sub cmb_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    MsgBox "Hello from cmb"
End Sub
 
 
Private Sub Lst_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    MsgBox "Hello from Lst"
End Sub

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
Dim MesControles() As New Classe1
 
Sub ShowDialog()
    Dim NbControles As Integer
    Dim ctl As Control
    NbControles = 0
    For Each ctl In UserForm1.Controls
        Select Case TypeName(ctl)
            Case "Label"
                NbControles = NbControles + 1
                ReDim Preserve MesControles(1 To NbControles)
                Set MesControles(NbControles).lbl = ctl
            Case "TextBox"
                NbControles = NbControles + 1
                ReDim Preserve MesControles(1 To NbControles)
                Set MesControles(NbControles).Tox = ctl
            Case "ListBox"
                NbControles = NbControles + 1
                ReDim Preserve MesControles(1 To NbControles)
                Set MesControles(NbControles).Lst = ctl
            Case "CommandButton"
                NbControles = NbControles + 1
                ReDim Preserve MesControles(1 To NbControles)
                Set MesControles(NbControles).cmd = ctl
            Case "OptionButton"
                NbControles = NbControles + 1
                ReDim Preserve MesControles(1 To NbControles)
                Set MesControles(NbControles).Opt = ctl
            Case "ComboBox"
                NbControles = NbControles + 1
                ReDim Preserve MesControles(1 To NbControles)
                Set MesControles(NbControles).cmb = ctl
        End Select
    Next ctl
End Sub
 
Private Sub UserForm_Click()
    ShowDialog
End Sub

C'est du travail de 15 minutes :scarymov:, ça marche (Office 2003) mais on peut toujours optimiser !!!

15/09/2005, 09h49
ouskel'n'or

Merci Ridan,
Je suis sûr que tous ceux qui ont Office 2003 vont être contents...
Chez moi, ça ne marche pas... ou alors, je n'ai pas réussi à adapter, pour Office 97, le peu de code qu'il y avait à adapter...

Je fais un dernier essai en prenant ta remarque en compte :

Citation:

Bon voilà pour ton erreur, je crois que c'est du fait qu'une instance de la classe control ne peut pas contenir un objet d'un autre type .... enfin je crois

Après quoi, je range ton code dans un tiroir en attendant de changer de version.

Encore merci.

A+
15/09/2005, 10h03
DarkVader

La solution utisant GetAsyncKeyState que tu avais proposée au départ Ridan
est pourtant celle qui semble la plus simple et surtout la plus générale -
par contre elle nécessite d'être utilisée dans un Timer et afin d'être certain
que la combinaison de touches s'adresse bien à l'appli désirée
en comparant avec l'appli active.
L'exemple fourni dans AllApi Key Spy correspond bien.
15/09/2005, 10h10
ouskel'n'or

Hello,

Dans l'un de mes essais, j'utilise effectivement GetAsyncKeyState pour tester la frappe, et ça marche.
Mon problème est (joujours) de faire marcher ça quelque soit le contrôle actif dans l'userform, et pas seulement et uniquement si ce contrôle est un commandButton.

Mais je n'ai pas encore vérifié le pb évoqué par Ridan...

A+

Bonjour DarkVader,

L'exemple donné sur AllApi semble fonctionner parfaitement selon les besoins d'ouskel'n'or, j'ai fais cette petite adaptation :

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
Public lolo As Long
Public Const DT_CENTER = &H1
Public Const DT_WORDBREAK = &H10
Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Declare Function DrawTextEx Lib "user32" Alias "DrawTextExA" (ByVal hDC As Long, ByVal lpsz As String, ByVal n As Long, lpRect As RECT, ByVal un As Long, ByVal lpDrawTextParams As Any) As Long
Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Global Cnt As Long, sSave As String, sOld As String, Ret As String
Dim Tel As Long
Sub GetPressedKey()
    If GetAsyncKeyState(116) <> 0 Then
        KillTimer lolo, 0
        MsgBox "Test"
    End If
End Sub

Sur un userform :

Code:

1
2
3
4
5
6
7
8
Private Sub UserForm_Activate()
    SetTimer ghwnd, 0, 1, AddressOf GetPressedKey
End Sub
 
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    KillTimer ghwnd, 0
    Unload Me
End Sub

Le code 116 correspond à la touche F5, ça marche aussi pour les contrôles ...

15/09/2005, 12h49
ouskel'n'or

Hello tous,

Merci du mal que vous vous donnez.

J'essaie ça cet aprem'

A+

PS - J'ai tellement trafiqué le code de mes essai que je n'ai plus rien qui marche... Ce tantôt, je recommence à zéro ! :evil:
15/09/2005, 14h07
ouskel'n'or

J'avais juste oublié : VBA 97 n'accepte pas AddressOf, soit la ligne

Code:

SetTimer ghwnd, 0, 1, AddressOf GetPressedKey

A+

PS - Et puis Ridan, j'avais omis de te dire que ce n'est pas gentil de me taper sur la tête...

Ben y a du tri à faire dans les poubelles lol

Citation:

Envoyé par ridan

Bonjour DarkVader,

L'exemple donné sur AllApi semble fonctionner parfaitement selon les besoins d'ouskel'n'or, j'ai fais cette petite adaptation :

Dans un module :

Code:

1
2
3
4
5
6
7
8
9
Public gWnd as long
Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
 
 
Sub GetPressedKey()
    If GetAsyncKeyState(116) <> 0 Then        MsgBox "Test"
End Sub

Sur un userform :

Code:

1
2
3
4
5
6
7
8
Private Sub UserForm_Activate()
    SetTimer ghwnd, 0, 1, AddressOf GetPressedKey
End Sub
 
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    KillTimer ghwnd, 0
    Unload Me
End Sub

Le code 116 correspond à la touche F5, ça marche aussi pour les contrôles ...

Citation:

Envoyé par ouskel'n'or

J'avais juste oublié : VBA 97 n'accepte pas AddressOf, soit la ligne

Code:

SetTimer ghwnd, 0, 1, AddressOf GetPressedKey

A+

:!: Avec vba332.dll installé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
        SetTimer ghwnd, 0, 1, AddressOf97("GetPressedKey")
    Else
        SetTimer ghwnd, 0, 1, AddressOf GetPressedKey
    End If
End Sub
Private Sub UserForm_Deactivate()
    KillTimer ghwnd, 0
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

Pas vérifié, mais ça devrait le faire - comme quoi, avec un minimum de recherche sur le net, on trouve tout.

Citation:

Envoyé par ouskel'n'or

Mais je n'arrive toujours pas à supprimer la répétition.

Augmente la fréquence du timer - 1 cycle par tick c'est trop - 100 c'est suffisant

Citation:

Envoyé par ouskel'n'or

En outre, je ne peux capturer qu'une touche définie par avance. Un test sur les valeurs que renvoie GetAsyncKeyState restant inaccessible (provoque une boucle sans fin qui plante Excel) que ce soit avec if dans la boucle

Normal si le cycle est trop court

Pour une saisie simultanée de plusieurs touches voir aussi
Code:

1 2 3 4 5 6 7 VK1 = GetAsyncKeyState(VK_SHIFT) VK2 = GetAsyncKeyState(VK_CONTROL) VK3 = GetAsyncKeyState(VK_ALT) VK4 = GetAsyncKeyState(VK_IMPR) Select Case True Case (VK1 And VK2 And VK4) < 0: ...

[Trucs & Astuces] VBA/xl/Utiliser les touches F1...F12 d

Je découvre les API et tente de trouver une méthode pour utiliser les touches du clavier afin de me déplacer dans le menu d'une fenêtre créée en API. Pas évident !

J'ai trouvé une adresse (c'est en anglais) qui peut donner des idées :
http://www.awprofessional.com/articles/article.asp?p=366892&seqNum=4&rl=1

Maintenant pour l'utiliser, j'essaie de comprendre (boucle ?, timer ?) . A voir.

A vous de découvrir et bonne chance !

En voici une partie :
Listing 9-9 shows the full code to check for a key press.
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 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 '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
Traduction globale du commentaire :
Quand nous appuyons sur une touche sur le clavier, la fenêtre active est envoyée à un message de WM_keydown, avec un code de bas niveau pour identifier la clef physique serrée. La première chose que nous devons faire, alors, est d'employer PeekMessage pour regarder dans la file d'attente de message pour voir s'il y a des messages en suspens de WM_keydown, l'enlevant de la file d'attente si nous trouvons un. Si nous trouvions un, nous devons le traduire en code de caractère en utilisant TranslateMessage, de nouveau au lequel envoie le message traduit ont excelé la file d'attente de message comme message de WM_char. Nous alors regardons dans la file d'attente de message pour ce message de WM_char et renvoyons le caractère serré.

Pensez à utiliser les balises de codes SVP -
mieux, à l'identer afin de le rendre plus lisible.

Voir 40 message(s) de cette discussion en une page