XL 2019 Saisi clavier dans une feuille de calcul

[Cemalatowilo]

Bonjour,
Est-il possible de détecter l'appuie sur n'importe qu'elle touche du clavier lorsque l'on est sur une feuille de calcul?
Je pense à utiliser Keypress, mais je ne sais pas comment m'y prendre.
Merci

 

[soan]

Bonjour Cemalatowilo,

je crois pas que c'est possible sur une feuille de calcul, mais c'est possible dans un UserForm (= formulaire) ; exemple pour un contrôle TextBox1 :​

Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
  If KeyAscii = 27 Then Unload Me
End Sub

l'utilisateur appuie sur n'importe quelle touche ; on teste si ça retourne le code 27 (code Escape = touche Échap) ; si c'est le cas, on ferme le UserForm.

(j'ai rien d'autre à proposer)​

soan

 

[Bernard_XLD]

Bonjour Cemalatowilo (ça, c'est du pseudo), soan, le forum

on peut détecter une touche ou une combinaison de touches précise avec onkey mais pas déterminer quelle touche a été pressée.
mais comme cela modifie la destination des touches, cela limite l'intérêt.
quelle est la finalité de ta demande ?

Cordialement

 

[Cemalatowilo]

Bonjour Yeahou,
Mon but est de rendre fixe par rapport à l'écran les segments d'un tableau structuré quand on le consulte via les flèches du clavier ou de la souris.
J'ai presque réussi avec les programmes suivants, mais gros bémol, quand je veux modifier le contenu d'une cellule j'ai un message qui m'informe que je n'ai pas le droit d'utiliser l'objet, il faut que je me rapproche de l'administrateur système ou du créateur de l'objet.
Je pensais contourner le problème en détectant la saisie du clavier pour arrêter la boucle récursive.
Voici ce que j'ai mis dans le code de la feuille:

Option Explicit
Public Depart As Single: Public Delta As Single
Public StopLanceur As Boolean
Dim SegmentShape1 As Shape
Dim SegmentShape2 As Shape
Dim SegmentShape3 As Shape
Dim SegmentShape4 As Shape
Dim SegmentShape5 As Shape
Dim premiereLigne As Integer
Sub FixeSegment()
'Cale les segments prédéfinis sur la première ligne visible de l'écran
'Pour un gain de temps, aucune vérification d'existence de segments
'n'est faite
    Set SegmentShape1 = Me.Shapes("Ss type")
    Set SegmentShape2 = Me.Shapes("Bénéficiaire")
    Set SegmentShape3 = Me.Shapes("Type")
    Set SegmentShape4 = Me.Shapes("Où")
    Set SegmentShape5 = Me.Shapes("Désignation")
    With ActiveWindow.VisibleRange 'Toutes les cellules visibles à l'écran
        premiereLigne = .Row
    End With
    SegmentShape1.Top = Cells(premiereLigne + 1, 1).Top
    SegmentShape2.Top = Cells(premiereLigne + 1, 1).Top
    SegmentShape3.Top = Cells(premiereLigne + 1, 1).Top
    SegmentShape4.Top = Cells(premiereLigne + 27, 1).Top
    SegmentShape5.Top = Cells(premiereLigne + 1, 1).Top
End Sub
Sub Lanceur()
    Delta = 0.001 'Les segments sont remis en place tous les Delta secondes
    StopLanceur = False
    While True
        Depart = Timer
        While Timer <= Depart + Delta
            'Worksheets(1).EnableCalculation = True
            DoEvents
            If StopLanceur = True Then Exit Sub
            'Worksheets(1).EnableCalculation = True
        Wend
        FixeSegment
        Lanceur
    Wend
End Sub
Sub StopperLanceur()
    StopLanceur = True
End Sub

Voici ce que j'ai mis dans ThisWorkbook:

Private Sub Workbook_Open()
    Feuil7.Lanceur
End Sub

 

[soan]

Bonjour Yeahou,

tu as écrit à propos de « Cemalatowilo » : « ça, c'est du pseudo »

« Cemalatowilo », c'est un peu comme le forgeron Cétautomatix (tu connais ? c'est celui qui s'amuse à taper sur le barde Assurancetourix en lui disant : « Non, tu ne chanteras pas ! non, tu ne chanteras pas ! ») ; pourtant, il me semblait que la musique adoucit les mœurs, non ? à quand un demandeur dont le pseudo sera Ocatarinetabellatchitchix ou Soupalognon y crouton ? (là, tu pourras jouer à taper le pseudo ! )

le OnKey, j'y pense que quand faut lancer une sub : « Cette méthode exécute une procédure spécifiée lorsque l'utilisateur appuie sur une touche ou une combinaison de touches. »​

soan

 

[Bernard_XLD]

Salut Soan, Cemalatowilo

Soan, il a fallu que je m'y reprenne à deux fois pour ne pas faire d'erreur dans le pseudo !

Pour Cemalatowilo, si j'ai bien compris ton besoin (et sans fichier de test pour comprendre, je suis loin d'en être sûr) tu devrais regarder du coté de l'interruption utilisateur redirigée sur une routine de gestion d'erreur.

Application.EnableCancelKey = xlErrorHandler

Bien cordialement

 

[Cemalatowilo]

Merci Yeajou, ton idée m'a permis de résoudre mon problème.
Bien que je ne sache toujours pas pourquoi je ne peux modifier l'objet!
Voici ma sub Lanceur modifiée:

Sub Lanceur()
    'Procédure récursive qui permet d'appeler FiweSegment tous les Delta seconde
    On Error GoTo ErreurClavier
    Application.EnableCancelKey = xlErrorHandler 'Permet de contrôler l'erreur qui m'indique que je ne peux pas utiliser
                                                 'quand je modifie une cellule
    
    Delta = 0.001
    StopLanceur = False 'Par défaut Lanceur est actif
    While True
        Depart = Timer
        While Timer <= Depart + Delta
            DoEvents 'Rend la main à l'utilisateur et au système
            If StopLanceur = True Then Exit Sub 'Arrète la procédure récursive
        Wend
        FixeSegment 'exécute FixeSegment
        Lanceur 'Relance la procédure récursive
    Wend
    
ErreurClavier:
    If Err = 18 Then
        StopperLanceur
    End If
End Sub

et voici ce que j'ai mis dans ThisWorkbook pour que Lanceur ne fonctionne que dans ma feuille "Depense 2021"

Private Sub Workbook_Open()
'Lance la procédure récursive à l'ouverture du classeur
'si le classeur active est "Dépense 2021
    If ActiveSheet.Name = "Dépense 2021" Then Feuil7.Lanceur
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
'A chaque changement de feuille relance la procédure récursive si
'la feuille active est "Dépense 2021"
    If ActiveSheet.Name = "Dépense 2021" Then
        Feuil7.Lanceur
    Else
        Feuil7.StopperLanceur
    End If
End Sub

Merci à tous pour votre aide

 

[Cemalatowilo]

Merci Yeajou, ton idée m'a permis de résoudre mon problème.
Bien que je ne sache toujours pas pourquoi je ne peux modifier l'objet!
Voici ma sub Lanceur modifiée:

Sub Lanceur()
    'Procédure récursive qui permet d'appeler FiweSegment tous les Delta seconde
    On Error GoTo ErreurClavier
    Application.EnableCancelKey = xlErrorHandler 'Permet de contrôler l'erreur qui m'indique que je ne peux pas utiliser
                                                 'quand je modifie une cellule
   
    Delta = 0.001
    StopLanceur = False 'Par défaut Lanceur est actif
    While True
        Depart = Timer
        While Timer <= Depart + Delta
            DoEvents 'Rend la main à l'utilisateur et au système
            If StopLanceur = True Then Exit Sub 'Arrète la procédure récursive
        Wend
        FixeSegment 'exécute FixeSegment
        Lanceur 'Relance la procédure récursive
    Wend
   
ErreurClavier:
    If Err = 18 Then
        StopperLanceur
    End If
End Sub

et voici ce que j'ai mis dans ThisWorkbook pour que Lanceur ne fonctionne que dans ma feuille "Depense 2021"

Private Sub Workbook_Open()
'Lance la procédure récursive à l'ouverture du classeur
'si le classeur active est "Dépense 2021
    If ActiveSheet.Name = "Dépense 2021" Then Feuil7.Lanceur
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
'A chaque changement de feuille relance la procédure récursive si
'la feuille active est "Dépense 2021"
    If ActiveSheet.Name = "Dépense 2021" Then
        Feuil7.Lanceur
    Else
        Feuil7.StopperLanceur
    End If
End Sub

Merci à tous pour votre aide

Désolé Yeajou heu .... Yeahou, bien que ton speudo soit court, je me trompe!

 

[Bernard_XLD]

Bien que je ne sache toujours pas pourquoi je ne peux modifier l'objet!

ben nous non plus, sans fichier

Désolé Yeajou heu .... Yeahou, bien que ton speudo soit court, je me trompe!

 

[soan]

Bonjour à tous,

j'adore ton avatar, myahou miaou ! j'aimais bien aussi l'avatar de Dudu2, dommage qu'il l'a enlevé ! c'était un joli papillon, vu de profil, avec des ailes bordées de vert et bleu.

énigme : Yeahou et meoua sont dans un bateau ; meoua tombe à l'eau ; qui c'est qui reste ? réponse : ben alors, Yeahou, qu'est-ce que t'attends pour aller secourir meoua ? il n'a toujours pas eu d'réponse à son problème de fichier xml :

oui bon d'accord, je sais : son sujet date du 31 Mai 2018 ; n'empêche qu'il vient d'passer tout récemment sur le forum dans l'espoir de lire ta réponse :

soan​

 

[soan]

question subsidiaire :

est-ce qu'on doit dire « Bienvenue » à un petit Nouveau de 2014 ?

à tout hasard, perso, j'y vois pas d'inconvénient ; alors : bienvenue meoua !

(mais comme j'y connais rien en xml, j'peux pas t'aider ! )

soan

 

[Bernard_XLD]

attention le petit jeune, respect pour les anciens du forum !
et aussi ceux de l'ancien forum d'avant 2005 d'ailleurs !
Bonne journée

 

[soan]

@Yeahou

ah oui, c'est vrai qu'tu t'es inscrit le 18 Mars 2005 ; moi aussi, mon inscription était le 18 ... en Août 2020.

soan

 

[Bernard_XLD]

tu sais qu'étant barbatruc, tu peux personnaliser ta signature et ton avatar ? privilège réservé aux barbatrucs, aux supporters et aux anciens du forum d'avant cette limitation.
C'est plus sympa qu'un S même majuscule !

 

[soan]

si, je sais bien, mais pour raisons persos, j'préfère quand même laisser comme ça. (merci quand même pour ta gentille proposition)​

soan