Détecter CRTL enfoncée

F

fifi

XLDnaute Occasionnel
Bonjour le forum

je sais qu'on ne peut pas interdire l'utilisation de la touche CTRL mais
peut on au moins savoir par macro si elle est appuyé ?

Le but étant d'éviter de faire tourner une macro événementielle lorsqu'une sélection multiple est en cours.
Et encore plus droit dans le but c'est de permettre en macro événementielle uniquement une fois que la sélection multiple est terminé.. c'est a dire quand on relâche le bouton CTRL.


merci
 
Trier par date Trier par votes
tototiti2008

tototiti2008

XLDnaute Barbatruc
Re : Détecter CRTL enfoncée

Bonjour fifi,

Je ne connais pas d'évènement sur les touches dans une feuille de calcul.
Par contre, si une sélection est en cours, il y a moyen de savoir si elle contient une ou plusieurs plages

Par exemple

Code: 
Msgbox Selection.Areas.count
 
Vote positif 0 Vote négatif
jeanpierre

jeanpierre

Nous a quitté
Repose en paix
Re : Détecter CRTL enfoncée

Bonsoir fifi, toto,

Tout dépend de ce que tu demandes à ta macro évenementielle....

Mais comme tu nous en dit peu sur la chose il est bien difficile de te guider.

Bonne nuit.

Jean-Pierre
 
Vote positif 0 Vote négatif
F

fifi

XLDnaute Occasionnel
Re : Détecter CRTL enfoncée

bonjour Jean Pierre,


la macro fait beaucoup de chose, hélas.

En autre elle dessine des courbes sur 2 graphiques pour les données correspondantes à la sélection.
Le problème est donc qu'à chaque sélection de cellule(s), la macro s'execute sans que je puisse sélectionner d'autre cellules non continue.
il n'y a pas de .select dans la macro.


je peux mettre le code de la macro événementielles mais ca ne va pas servir à grand chose..enfin je pense :D

Code: 
If Not Application.Intersect(Target, Range("Exploit_CT_result")) Is Nothing Then

''''affichhage de la sélection pour les différent types de sélection possible puis recherche des info en fonction des puits sélectionnées


'Sheets("Exploitation_QPCR").unprotect ("4862")
'Sheets("listes").unprotect ("4862")
Application.EnableEvents = False
Run "calc_off"
Dim nb_color As Integer
Dim Nb_ligne As Integer
'''selection sur plaque
SelectionSurPlaque:
    Range("Exploit_CT_result").Font.Bold = False
    '''Ecriture du nom de l'échantillon
        With Sheets("Exploitation_QPCR").Range("Exploitation_coords")
           Set c = .Find(LCase(Cells(Selection.Row, 1)) & Cells(3, Selection.Column), LookIn:=xlFormulas) ' <<Plate Layout>>
           Sheets("listes").Range("Listes_selected_well_name") = Cells(c.Row, Range("Exploitation_sample_name_small_col").Column)
        End With
           ''sélection sur plaque en fonction de l'option choisie
           Range("Graph_selected_well") = 0  '''mise à zéro du nombre de série sélectionnées
           Range("Exploitation_données_sélection").ClearContents
           Range("Exploitation_données_sélection").Interior.ColorIndex = xlNone
           
        info1 = Range("Result_intitulé_1")
        info2 = Range("Result_intitulé_2")
        Range("Result_intitulé_1") = "Cibles"
        Range("Result_intitulé_2") = "SAMPLENAME"
        'Run "rafraichissement_plaque"
        Range("Exploit_CT_result").FormulaR1C1 = "=Exploit_plate"
        Range("Exploit_CT_result") = Range("Exploit_CT_result").Value
        Sheets("Exploitation_QPCR").Range("Exploitation_sample_name_selected").ClearContents
        Range("Exploitation_listes_primers_in_use").ClearContents
        Range("Exploitation_listes_primers_in_use").Interior.ColorIndex = xlNone
        I = 0
             
           Select Case Sheets("listes").Range("Listes_affichage_type")
           Case "Unique"
           
Unique:   ''retour si sélection unique avec un seul puits
       Sheets("listes").Range("listes_nb_serie_en_cours") = 1

                Dim Décalage As Integer
                Décalage = -1
                    If Cells(Target.Row, 2) = Cells(Target.Row + 1, 2) Then Décalage = 1
                        '''mise en gras du puits sélectionné
                        Target.Font.Bold = True
                        Target.Offset(Décalage, 0).Font.Bold = True
                        
                         If Cells(Target.Row, 2) = Cells(Target.Row + 1, 2) Then
                            Range("Graph_selected_well").Offset(I, -1) = Target
                            Range("Graph_selected_well").Offset(I, 0) = Target.Offset(Décalage, 0)
                         Else
                            Range("Graph_selected_well").Offset(I, -1) = Target.Offset(Décalage, 0)
                            Range("Graph_selected_well").Offset(I, 0) = Target
                         End If
                       '''coloriage primers sélection en utilisation
                        With Sheets("listes").Range("Listes_col_primer")
                            Set d = .Find(Target.Offset(Décalage, 0), LookIn:=xlValues)
                        End With
                        Range("Graph_selected_well").Offset(I, -1).Interior.ColorIndex = d.Interior.ColorIndex
                        Range("Graph_selected_well").Offset(I, -1).Font.ColorIndex = d.Font.ColorIndex
                        Range("Graph_selected_well").Offset(I, -1).Font.Bold = d.Font.Bold


                    Range("Result_intitulé_1") = info1
                    Range("Result_intitulé_2") = info2
                    Run "rafraichissement_plaque"

                    Sheets("listes").Range("Graph_selected_well") = 1
            Case "Echantillon"
            '''détection des primers de l'échantillon
            '''boucle pour afficher les primers dispo
            Z = 1
'            Echantillon = Target.Offset(-1, 0)
'            If Cells(c.Row, 2) = Cells(c.Row - 1, 2) Then Echantillon = Target
                
           For Each c In Sheets("Exploitation_QPCR").Range("Exploit_primer_sample_col")
                  With Sheets("Exploitation_QPCR").Range("Exploitation_listes_primers_in_use")
                     Set d = .Find(c, LookIn:=xlValues)
                     If d Is Nothing And c <> "not found" And c <> 0 Then
                    ' MsgBox Cells(c.Row, Range("Exploitation_sample_name_small_col").Column)
                          If Cells(c.Row, Range("Exploitation_sample_name_small_col").Column) = Sheets("listes").Range("Listes_selected_well_name") Then
                            Sheets("Exploitation_QPCR").Range("exploitation_init_primer_selection").Offset(Z, 0) = c
                            Z = Z + 1
                            'If z > 25 Then GoTo fin_primer_liste   'pas de limite sur l'instauration du détail
                         End If
                     End If
                  

                     '''mise en gras du/des puits sélectionné(s)
                    If Cells(c.Row, 2) = Cells(c.Row - 1, 2) Then
                        Range("Graph_selected_well") = Range("Graph_selected_well") + 1
                        c.Font.Bold = True
                        c.Offset(1, 0).Font.Bold = True
                    Else
                        Range("Graph_selected_well") = Range("Graph_selected_well") + 1
                        c.Font.Bold = True
                        c.Offset(-1, 0).Font.Bold = True
                    End If
                  End With
                       'Sheets("listes").Range("listes_nb_serie_en_cours") = z ''''
           Next c
           Sheets("listes").Range("listes_nb_serie_en_cours") = Z ''''
fin_primer_liste:

                Sheets("Exploitation_QPCR").Range("Exploitation_sample_name_selected").FormulaR1C1 = "=IF(RC[-1]="""","""",Listes!Listes_selected_well_name&""_""&RC[-1])"
                Sheets("Exploitation_QPCR").Range("Exploitation_sample_name_selected").Calculate
                
                '''coloriage des primers en utilisation
                For Each c In Sheets("Exploitation_QPCR").Range("Exploitation_listes_primers_in_use")
                    If c = "" Then GoTo fin_couleur_primer
                    With Sheets("listes").Range("Listes_col_primer")
                       Set d = .Find(c, LookIn:=xlValues) ' <<Plate Layout>>
                    End With
                       c.Interior.ColorIndex = d.Interior.ColorIndex
                       c.Font.ColorIndex = d.Font.ColorIndex
                       c.Font.Bold = d.Font.Bold

                Next c
fin_couleur_primer:

                
                
            Case "Sélection"

                Z = 0 '''compteur d'item dans selection
                'If c.Count = 1 Then GoTo Unique
                For Each c In Selection
                    If c.Font.Bold = True Then GoTo cellsuivante3 '''évite la double utilisation du puits
                    'If Cells(c.Row, 2) = Cells(c.Row + 1, 2) Then GoTo cellsuivante3
                        If c = "" Then GoTo cellsuivante3
                        Z = Z + 1
                         If Cells(c.Row, 2) = Cells(c.Row + 1, 2) Then
                            Range("Graph_selected_well").Offset(I, -1) = c
                            Range("Graph_selected_well").Offset(I, 0) = c.Offset(1, 0)
                            c.Font.Bold = True
                            c.Offset(1, 0).Font.Bold = True

                         Else
                            Range("Graph_selected_well").Offset(I, -1) = c.Offset(-1, 0)
                            Range("Graph_selected_well").Offset(I, 0) = c
                            c.Font.Bold = True
                            c.Offset(-1, 0).Font.Bold = True
                        End If

                       '''coloriage primers sélection en utilisation

                        With Sheets("listes").Range("Listes_col_primer")
                            Set d = .Find(Range("Graph_selected_well").Offset(I, -1), LookIn:=xlValues)
                        End With
                        Range("Graph_selected_well").Offset(I, -1).Interior.ColorIndex = d.Interior.ColorIndex
                        Range("Graph_selected_well").Offset(I, -1).Font.ColorIndex = d.Font.ColorIndex
                        Range("Graph_selected_well").Offset(I, -1).Font.Bold = d.Font.Bold
                        I = I + 1
                        Sheets("listes").Range("listes_nb_serie_en_cours") = Z
cellsuivante3:
                Next c
                'if Z = 0 then
                    Range("Result_intitulé_1") = info1
                    Range("Result_intitulé_2") = info2
                    Run "rafraichissement_plaque"
                    
            Case "cible"


                Z = 0
                '''recherche du primer selectionné
                If Cells(Target.Row, 2) = Cells(Target.Row + 1, 2) Then
                    Primer = Target
                Else
                    Primer = Target.Offset(1, 0)
                End If
                
                '''coloriage primers sélection en utilisation
                 With Sheets("listes").Range("Listes_col_primer")
                     Set d = .Find(Primer, LookIn:=xlValues)
                 End With
                
                For Each c In Range("Exploit_CT_result")
                        If Cells(c.Row, 2) = Cells(c.Row + 1, 2) Then GoTo cellsuivante4
                        Sheets("listes").Range("Graph_selected_well") = Sheets("listes").Range("Graph_selected_well") + 1
                        If c.Offset(-1, 0) <> Primer Then GoTo cellsuivante4
                        If c = "" Then GoTo cellsuivante4
                        Z = Z + 1
                        
                        Range("Graph_selected_well").Offset(I, -1) = c.Offset(-1, 0)
                        Range("Graph_selected_well").Offset(I, 0) = c
                        Range("Graph_selected_well").Offset(I, -1).Interior.ColorIndex = d.Interior.ColorIndex
                        Range("Graph_selected_well").Offset(I, -1).Font.ColorIndex = d.Font.ColorIndex
                        Range("Graph_selected_well").Offset(I, -1).Font.Bold = d.Font.Bold
                        I = I + 1
                        '''mise en gras du puits sélectionné
                        c.Font.Bold = True
                        c.Offset(-1, 0).Font.Bold = True
                Sheets("listes").Range("listes_nb_serie_en_cours") = Z
cellsuivante4:
                Next c
                    Range("Result_intitulé_1") = info1
                    Range("Result_intitulé_2") = info2
                    Run "rafraichissement_plaque"
            
            Case "Ligne"
choix_ligne:

           ''sélection sur plaque en fonction de l'option choisie
       Range("Graph_selected_well") = 0  '''mise à zéro du nombre de série sélectionnées
       Range("Exploitation_données_sélection").ClearContents
       Range("Exploitation_données_sélection").Interior.ColorIndex = xlNone
           
        info1 = Range("Result_intitulé_1")
        info2 = Range("Result_intitulé_2")
        Range("Result_intitulé_1") = "Cibles"
        Range("Result_intitulé_2") = "SAMPLENAME"
        'Run "rafraichissement_plaque"
        Range("Exploit_CT_result").FormulaR1C1 = "=Exploit_plate"
        Range("Exploit_CT_result") = Range("Exploit_CT_result").Value
        Sheets("Exploitation_QPCR").Range("Exploitation_sample_name_selected").ClearContents
        Range("Exploitation_listes_primers_in_use").ClearContents
        Range("Exploitation_listes_primers_in_use").Interior.ColorIndex = xlNone
        I = 0
                  
                Dim Ligne_selectionnée As Integer

                '''recherche de la ligne selectionnée
                If Cells(Target.Row, 2) = Cells(Target.Row + 1, 2) Then
                   Ligne_selectionnée = Cells(Target.Row, 2)
                Else
                   Ligne_selectionnée = Cells(Target.Row, 2)
                End If
                I = 0
                For Each c In Range("exploitation_intitulé_colonne").Offset(Ligne_selectionnée * 2, 0)
                    If c = "" Then GoTo cellsuivante5
  
                        '''coloriage primers sélection en utilisation
                        With Sheets("listes").Range("Listes_col_primer")
                            Set d = .Find(c.Offset(-1, 0), LookIn:=xlValues)
                        End With
                        
                        Range("Graph_selected_well").Offset(I, -1) = c.Offset(-1, 0)
                        Range("Graph_selected_well").Offset(I, 0) = c
                        Range("Graph_selected_well").Offset(I, -1).Interior.ColorIndex = d.Interior.ColorIndex
                        Range("Graph_selected_well").Offset(I, -1).Font.ColorIndex = d.Font.ColorIndex
                        Range("Graph_selected_well").Offset(I, -1).Font.Bold = d.Font.Bold
                        I = I + 1
                        '''mise en gras du puits sélectionné
                        c.Font.Bold = True
                        c.Offset(-1, 0).Font.Bold = True
               Sheets("listes").Range("listes_nb_serie_en_cours") = 1
cellsuivante5:
                Next c
                    Range("Result_intitulé_1") = info1
                    Range("Result_intitulé_2") = info2
                    Run "rafraichissement_plaque"
                    Sheets("listes").Range("Graph_selected_well") = 8
            Case "colonne"
choix_colonne:
        Range("Exploit_CT_result").Font.Bold = False
        Range("Graph_selected_well") = 0  '''mise à zéro du nombre de série sélectionnées
        Range("Exploitation_données_sélection").ClearContents
        Range("Exploitation_données_sélection").Interior.ColorIndex = xlNone
           
        info1 = Range("Result_intitulé_1")
        info2 = Range("Result_intitulé_2")
        Range("Result_intitulé_1") = "Cibles"
        Range("Result_intitulé_2") = "SAMPLENAME"
        'Run "rafraichissement_plaque"
        Range("Exploit_CT_result").FormulaR1C1 = "=Exploit_plate"
        Range("Exploit_CT_result") = Range("Exploit_CT_result").Value
        Sheets("Exploitation_QPCR").Range("Exploitation_sample_name_selected").ClearContents
        Range("Exploitation_listes_primers_in_use").ClearContents
        Range("Exploitation_listes_primers_in_use").Interior.ColorIndex = xlNone
        I = 0
        
            Dim colonne_selectionnée As Integer

                
                '''recherche du primer selectionné
                colonne_selectionnée = Cells(Range("exploitation_intitulé_colonne").Row, Target.Column)
                For Each c In Range("exploitation_intitulé_ligne").Offset(0, colonne_selectionnée)
                        If Cells(c.Row, 2) = Cells(c.Row + 1, 2) Then GoTo cellsuivante6
                        If c = "" Then GoTo cellsuivante6
                        
                        '''coloriage primers sélection en utilisation
                        With Sheets("listes").Range("Listes_col_primer")
                            Set d = .Find(c.Offset(-1, 0), LookIn:=xlValues)
                        End With
                        
                        Range("Graph_selected_well").Offset(I, -1) = c.Offset(-1, 0)
                        Range("Graph_selected_well").Offset(I, -1).Select
                        Range("Graph_selected_well").Offset(I, 0) = c
                        Range("Graph_selected_well").Offset(I, -1).Interior.ColorIndex = d.Interior.ColorIndex
                        Range("Graph_selected_well").Offset(I, -1).Font.ColorIndex = d.Font.ColorIndex
                        Range("Graph_selected_well").Offset(I, -1).Font.Bold = d.Font.Bold
                        I = I + 1
                        '''mise en gras du puits sélectionné
                        c.Font.Bold = True
                        c.Offset(-1, 0).Font.Bold = True
                Sheets("listes").Range("listes_nb_serie_en_cours") = 8
cellsuivante6:
                Next c
                    Range("Result_intitulé_1") = info1
                    Range("Result_intitulé_2") = info2
                    Run "rafraichissement_plaque"
                    Sheets("listes").Range("Graph_selected_well") = 12
            Case Else
                        '''mise en gras du puits sélectionné
                        c.Font.Bold = True
                        c.Offset(-1, 0).Font.Bold = True
                        Sheets("listes").Range("Graph_selected_well") = 0
           End Select
Application.DisplayAlerts = False
            Run "Exploitation_info_selection"

''''gestion de l'affichage
'Run "réactivation"
If Sheets("listes").Range("Listes_affichage_exploit") <> "Plaque" Then
    Run "Graphiques"
End If

    GoTo fin2
End If

Code: 
fin2:
Application.DisplayAlerts = True
Application.EnableEvents = True
Run "protect"
End
End Sub
 
Vote positif 0 Vote négatif
F

fifi

XLDnaute Occasionnel
Re : Détecter CRTL enfoncée

j'ai un début de solution par un moyen détourné

1) création d'une plage nommées
Code: 
ActiveWorkbook.Names.Add Name:="sélection", RefersToR1C1:=Selection

2) désactivation des évenements
Code: 
Application.EnableEvents = false

3)La macro événementielle tourne

3) Sélection de la plage sélection avant réactivation des événements
Code: 
Application.EnableEvents = True


La contrainte est que la macro a tout de même fonctionnée et prend un peu de temps (surtout le run "graphique" environ 3secondes) du coup la sélection suivantes (avec CTRL enfoncé) la macro "graphique" reprends encore 3s.

donc cela fait 6 secondes d'attente pour l'affichage du résutlats de la sélection au lieu de 3).

mais c'est un début.
 
Vote positif 0 Vote négatif
JNP

JNP

XLDnaute Barbatruc
Re : Détecter CRTL enfoncée

Bonjour le fil :),
Une solution, qui n'est pas à mon avis une lourde contrainte, est de baser l'évènement sur le clic droit au lieu du changement de sélection, en faisant juste un clic droit en fin de sélection
Code: 
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
MsgBox Target.Address
End Sub
Bon WE :cool:
 
Vote positif 0 Vote négatif
F

fifi

XLDnaute Occasionnel
Re : Détecter CRTL enfoncée

mon BeforeRightClick est déjà utilisé sur la plage visé pour afficher un userform de saisi d'info concernant la cellule.

l'autre contrainte est aussi que cela change l'habitude de l'utilisateur concernant cette sélection.

merci tout de même.
 
Vote positif 0 Vote négatif
camarchepas

camarchepas

XLDnaute Barbatruc
Re : Détecter CRTL enfoncée

Bonjour,

J'ai peut être une solution.

Un inputbox un peu spécial, qui te permets de sélectionner des champs multiples en appuyant justement sur CTRL, cela arrête le programme jusqu'à validation du OK

C'est à toi de voir avec la globalité de l'application .
Sub test()
Dim zone As Range
Set zone = Application.InputBox("Sélection des zones à prendre en compte", "ATTENTE DE VALIDATION UTILISATEUR", Type:=8)
resultat = zone.Address

End Sub
Cliquez pour agrandir...

tu récupères les zones dans la chaine résultat , aprés si besoin y'a plus qu'à découper
 
Vote positif 0 Vote négatif
F

fifi

XLDnaute Occasionnel
Re : Détecter CRTL enfoncée

bonjour,
ca peut , le faire
c'est moins fluide et surtout cela montre à l'utilisateur des info qu'il n' a pas besoin de voir mais je vais essayer avec ..sinon ca sera la façon décomposée précédente..

y a pas une fonction qui indique si CTRL est enfoncé ?

si il y a d'autre idée :D
 
Vote positif 0 Vote négatif
F

fifi

XLDnaute Occasionnel
Re : Détecter CRTL enfoncée

pour la derniére solution cela donne ca

Code: 
Global Const VK_CONTROL = &H11
Private Declare Function GetKeyState Lib "user32" _
    (ByVal vKey As Long) As Integer
Function DisableVK_CONTROL()
    If GetKeyState(VK_CONTROL) < 0 Then ActiveCell.Select
End Function

et dans le module de feuille
Code:
Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
DisableVK_CONTROL
End Sub


effectivement j'arrive a limiter la macro évenementielle pour faire une sélection multiple sauf que pour terminer la sélection multiple il faut penser à relacher la bouton CTRL pendant la sélection sinon.... y a pas de macro ^^


je pense que parmi les différentes solutions celles en plusieurs temps reste la meilleurs pour le moment.

merci a tous en tout ca.
 
Vote positif 0 Vote négatif

Discussions similaires

R
  • Question
Autres Copie dans le presse-papier d'une sélection multiple
2
Réponses
16
Affichages
885
Renaud22
R
F
  • Résolu(e)
XL 2019 un copier coller de plage cellules automatisé pour listing dynamique
Réponses
10
Affichages
389
Formulatix
F
oguruma
POWERQUERY :: Simuler la lecture séquentielle d'un fichier texte comme en VBA - While Not Eof(1) ... Wend
Réponses
2
Affichages
217
oguruma
oguruma
K
  • Question
Microsoft 365 Invalider le Click Droit dans Excel
Réponses
4
Affichages
739
Katido
K
T
  • Question
Microsoft 365 VBA sous excel pour écrire dans doc word
Réponses
2
Affichages
731
Titi71
T
E
  • Résolu(e)
Microsoft 365 Conception d'un outils alliant faciliter d'utilisation et optimisation de la RAM/Processeur/Espace Disque
Réponses
6
Affichages
492
elgringo123456
E
Lu76Fer
XLS : Créer une animation fluide sans Crash (ou presque) !
Réponses
7
Affichages
337
Lu76Fer
Lu76Fer
P
  • Question
XL 2019 Macro qui exporte au format PDF bloquée par BeforePrint = Cancel = True
Réponses
4
Affichages
575
pat66
P
V
  • Résolu(e)
Microsoft 365 Afficher filtres appliqués par macro dans la cellule B3 directement et non par F5 puis Réinitialiser
Réponses
12
Affichages
1 K
VirginieG
V
D
  • Question
XL 2019 Aide à la compréhension d'un code VBA
Réponses
4
Affichages
741
Dudu2
Dudu2

Membres actuellement en ligne

10 membres et 108 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 491
Messages
2 088 889
Membres
103 982
dernier inscrit
krakencolas