Sur double-clic dans une cellule, pointer le curseur dans un autre tableau

Le 22/10/2025 à 20:08

Bonsoir,

Serait-il possible, sur double-clique dans une cellule (entourée en rouge) de faire pointer le curseur (c'est à dire le pointeur de la souris) dans un autre tableau (entourée en bleu), et plus précisément sur la ligne qui a été rajoutée dans ce tableau "TBL_5ateliers" (dans l'exemple, ligne 21)

Parce que pour le moment la souris pointe sur la cellule du double-clique mais je voudrais éviter cela

image

Code VBA dans l'objet "feuil2 (5 ateliers)" :

'Feuille 5 ateliers

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
     On Error GoTo Catch
     Cancel = True                           ' // On evite de passer en mode édition après l'éxécution du code

     Dim Ateliers As Excel.ListObject
     Set Ateliers = Me.Range("TBL_5Ateliers").ListObject

     If Not Ateliers Is Nothing Then         ' // Le tableau exist-il bien ?
          Application.EnableEvents = False

          'TODO "Utiliser une constante pour ce mot de passe."
          Me.Unprotect Password:=GlobalConstants.SHEETS_MDP

          'TODO "Utiliser une autre méthode pour sélectionner un nom. par exemple une zone de liste déroulante."
          If Not Intersect(Target, Me.Range("tabel8[noms]")) Is Nothing Then
               Dim arr As Variant
               'TODO "Le formatage doit-être fait avant. (A l'insertion d'un nouveau nom par exemple.)
               arr = Array(UCase(Target.Value), Application.Proper(Target.Offset(0, 1).Value), UCase(Target.Offset(0, 2).Value))
               Dim newRow As Excel.ListRow
               If GlobalConstants.POSITION_TO_ADD_ON_TAB > 0 Then
                    Set newRow = Ateliers.ListRows.Add(Position:=GlobalConstants.POSITION_TO_ADD_ON_TAB)     ' // Par défaut on ajoute à la fin du tableau. modification dans le module GlobalConstants.
               Else
                    Set newRow = Ateliers.ListRows.Add     ' // Par défaut on ajoute à la fin du tableau. modification dans le module GlobalConstants.
               End If
               With newRow
                    .Range.Range("A1:C1").Value = arr
                    .Range.Range("D1:W1").Value = 0
               End With
          End If
          Me.Protect Password:=GlobalConstants.SHEETS_MDP
     End If

Finally:
     Application.EnableEvents = True
     Exit Sub

Catch:
     ' // Do something.
     MsgBox "Oupss... Nous avons rencontré une erreur : " & Err.Number & _
            " (" & Err.Description & ") dans la procédure tempSub du Document VBA Feuil2"

     Resume Finally

End Sub

Private Sub tempSub(ByVal Target As Range, Cancel As Boolean)
     On Error GoTo Catch
     Cancel = True                           ' // On evite de passer en mode édition après l'éxécution du code

     Dim Ateliers As Excel.ListObject
     Set Ateliers = Me.Range("TBL_5Ateliers").ListObject

     If Not Ateliers Is Nothing Then         ' // Le tableau exist-il bien ?
          Application.EnableEvents = False
          'TODO "Utiliser une constante pour ce mot de passe."
          Me.Unprotect Password:="seb"
          'TODO "Utiliser une autre méthode pour sélectionner un nom."
          If Not Intersect(Target, Me.Range("tabel8[noms]")) Is Nothing Then
               Dim arr As Variant
               arr = Array(UCase(Target.Value), Application.Proper(Target.Offset(0, 1).Value), UCase(Target.Offset(0, 2).Value))
               Dim newRow As Excel.ListRow
               Set newRow = Ateliers.ListRows.Add
               With newRow
                    .Range = arr
               End With
          End If

     End If

Finally:
     Application.EnableEvents = True
     Exit Sub

Catch:
     ' // Do something.
     MsgBox "Oupss... Nous avons rencontré une erreur : " & Err.Number & _
            " (" & Err.Description & ") dans la procédure tempSub du Document VBA Feuil2"

     Resume Finally
End Sub

En tout cas, merci beaucoup de vous être intéressé à ce sujet.

9vierge4-jeux-penitentiaires-2025-8-vba-avec-medailles-petanque.xlsb (229.72 Ko)

Sur le bouton "Débloquer ou Quitter", tapez vodoraix pour tt débloquer.

Et mot de passe pour débloquer les feuilles ==> seb

Bonne soirée

à bientôt

Le 22/10/2025 à 23:23

Bonjour,

quand on propose un fichier qui change l'environnement on désactive ça.
Je n'aime pas me voir imposer le plein écran, tous les menus enlevés, et la croix de fermeture grisée.
Je suis assez grand pour savoir comment je veux mon excel, c'est désagréable.

Sub Workbook_Open()
     Dim arr, b
     Application.Goto Sheets("Classmt par discipline+Général").Range("A3"), 1
     Sheets("Stats").Visible = True
     Sheets("Concordance Classmt & points").Visible = xlVeryHidden
     Sheets("dossiers pour PDF").Visible = xlVeryHidden
     On Error Resume Next
     With Application
          .DisplayFullScreen = True
          .CommandBars("Worksheet Menu Bar").Enabled = False
     End With
     DisableSystemMenu
     Application.OnKey "{ESCAPE}", ""
     On Error GoTo 0

     'Arr = Array("BSA", "Seb DORV", "DORVEAUX Sebastien")     'matrice avec tous les noms qui ont accès à la feuille 2
     'b = Application.IfError(Application.Match(Application.UserName, Arr, 0), 0)     'vérification personnes
     'Sheets("Concordance Classmt & Points").Visible = IIf(b, xlSheetVisible, xlSheetVeryHidden)     'très cachée
     'Sheets("Dossiers pour pdf").Visible = IIf(b, xlSheetVisible, xlSheetHidden)     'cachée
     '
     'bOpen = True
     's = Dossier
     'bOpen = False
     Proteger
End Sub

eriiic

PS : et mon excel ne veut plus se relancer. J'espère qu'un reboot suffira. Avis aux suivants...

Le 22/10/2025 à 23:33

Bonsoir à tous,

Petite approche via le ruban.

@vodoraix faites un test en basculant sur la feuille '5 ateliers', puis sur 'classmt par discipline+général'

C'est un premier jet pour voir si cela vous convient, la plupart des commandes du ruban sont sans effet.

Le 23/10/2025 à 06:53

Bonjour et merci à vous 2

Jean-Paul ==> Désolé je n'ai pas trop compris car tout est changé et les essais sont pris sur un tout autre classeur et donc événement différent.

Le tableau Tabel8 n'existe plus...

eriiic ==> Je suis obligé de faire un blocage car bcp d'utilisateurs débutants risquent de faire des bêtises dessus...

Mais c'est vrai que je n'ai plus besoin de la matrice "array" avec tous les noms qui ont accès à la feuille. Je vais essayer de supprimer cette partie...

Merci à vous 2...

Bonne journée

Le 23/10/2025 à 12:44

Bonjour,

ça c'est ton choix à voir avec tes utilisateurs. Ici tu peux (dois) mettre en commentaire le code qui ne sert pas pour le pb.
eriiic

Le 23/10/2025 à 17:45

Bonjour eriiic,

Je n'ai pas compris ton

Ici tu peux (dois) mettre en commentaire le code qui ne sert pas pour le pb.

Est-ce que tu veux dire que je n'ai pas indiqué les bons sub qui concernent le pb ?

Finalement, je crois que j'ai compris après qqes minutes de réflexion ==> Il faut que je mette le classeur en accès normal sans blocage. Seulement, je ne sais pas comment faire

Merci

à+

Le 23/10/2025 à 18:09

Bonjour à tous,

Pour ma part je n'ai pas cherché beaucoup...

Sub Workbook_Open()
'     Dim arr, b
'     Application.Goto Sheets("Classmt par discipline+Général").Range("A3"), 1
'     Sheets("Stats").Visible = True
'     Sheets("Concordance Classmt & points").Visible = xlVeryHidden
'     Sheets("dossiers pour PDF").Visible = xlVeryHidden
'     On Error Resume Next
'     With Application
'          .DisplayFullScreen = True
'          .CommandBars("Worksheet Menu Bar").Enabled = False
'     End With
'     DisableSystemMenu
'     Application.OnKey "{ESCAPE}", ""
'     On Error GoTo 0
'
'     'Arr = Array("BSA", "Seb DORV", "DORVEAUX Sebastien")     'matrice avec tous les noms qui ont accès à la feuille 2
'     'b = Application.IfError(Application.Match(Application.UserName, Arr, 0), 0)     'vérification personnes
'     'Sheets("Concordance Classmt & Points").Visible = IIf(b, xlSheetVisible, xlSheetVeryHidden)     'très cachée
'     'Sheets("Dossiers pour pdf").Visible = IIf(b, xlSheetVisible, xlSheetHidden)     'cachée
'     '
'     'bOpen = True
'     's = Dossier
'     'bOpen = False
'     Proteger
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'     EnableSystemMenu

Voilà là c'est réglé.....

Le 23/10/2025 à 18:13

Tout simplement

Voilà, c'est fait, merci

6vierge4-jeux-penitentiaires-2025-8-vba-avec-medailles-petanque.xlsb (229.82 Ko)
Rechercher des sujets similaires à "double clic pointer curseur tableau"