Extrapoler le VBA sur 1 autre feuill dont les caractéristiques sont proches

Le 30/07/2025 à 18:32

Bonjour,

Arturo83 m'a réalisé un travail réussi sur la feuille "5 ateliers".

Il me faudrait les mêmes fonctions sur 2 autres feuilles dont les caractéristiques sont très très proches ;-)))))

Évidemment, il ne s'agit pas que d'un copié/collé car le nombre de colonnes est différents.

Et dans le "Tir à 13 cibles", ça ne rapporte qu'un seul point par réussite. Ainsi sur cette feuille, pourrons-nous, par un clique sur une cellule, provoqué un "0" ou un "1". Ca permettra d'enregistrer les scores sans le clavier et aller plus vite.

Qu'en pensez-vous ?

Merci beaucoup de me lire :-)))))))

10jeux-penitentiaires-2025.xlsb (203.72 Ko)

Bonne soirée :-)))))))))))))))))

à bientôt ... ;-)

Le 31/07/2025 à 12:33

Bonjour,

Essayez ceci:

9jeux-penitentiaires-2025-2-2.xlsb (198.94 Ko)

Cdlt

Le 31/07/2025 à 17:23

Bonjour Arturo83 et merci beaucoup :-))))))))))))))

En réalité, pour ces 2 autres feuilles, j'aurais besoin des mêmes fonctionnalités que la feuille "5 ateliers". Celle que tu m'as créée ;-)))

Les 3 boutons + la même configuration pour le tableau des scores...

En tout cas merci d'insister gentiment à trouver des solutions à mes soucis de fonctionnement :-))))))))))))))

à bientôt :-)))))))))))

Bonne soirée :-)))))))))))))

Le 31/07/2025 à 18:43

En espérant n'avoir rien oublié

7jeux-penitentiaires-2025-3.xlsb (258.98 Ko)

Cdlt

Le 31/07/2025 à 23:32

Franchement, tu m'as fait encore un super boulot ! :-)))))))))))))))))))))))))

Juste pour la feuille "13 cibles", c'est "0" ou "1" et pas 0, 1, 3, 5. Et j'aurais aimé qu'en cliquant-droit sur la cellule, ça me fasse un "0" et au prochain clique sur cette même cellule, ça me fait un "1", etc, etc. En réalité, comme ce qui avait été fait sur la feuille 1 en colonne "D" pour le flipflop des "F" et "H".

Voici le code qu'il faudrait arriver à adapter à la feuille "13 cibles" ==>

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)

     Dim Isect As Range, cboTemp, str

     Set b = Me.Range("tabel1").ListObject.HeaderRowRange

     Set Isect = Intersect(Target, b.Offset(-1).Resize(2))     'vérifier si on fait ce double-clicque dans l'entête du tableau ou la ligne dessus (lignes 3-4)
     If Not Isect Is Nothing Then Cancel = True: Trier Isect.Column - b.Column + 1: Exit Sub     'double-clicque ok, donc trier la colonne du double-clicque

     Set Isect = Intersect(Target, Me.Range("tabel1[sexe]"))     'double-clicque dans la colonne "sexe" du tableau
     If Not Isect Is Nothing Then
          With Isect(1)
               .Value = IIf(UCase(.Value) = "H", "F", "H")     'flipflop sexe : H et F
          End With
          Cancel = True
          Exit Sub
     End If

     Set Isect = Intersect(Target, Me.Range("tabel1").Columns(2))
     If Not Isect Is Nothing Then
          Set cUF1 = Isect.Cells(1)
          With UserForm1
               .Left = cUF1.Offset(, 1).Left     'juste à droite de la cellule
               .Top = Application.Min(500, cUF1.Top + 200)     'hauteur approx. pour encore voir tout après le "dropdown"
               .Show
          End With
          With UserForm1.ListBox1
               If .ListIndex <> -1 Then cUF1.Value = .List(.ListIndex)
          End With

          Unload UserForm1
          Cancel = True
     End If

End Sub

Qu'en penses-tu ?

Encore merci Arturo83 :-))))))))))))))))))))))))

Bonne soirée :-)))))))))))))))

Le 01/08/2025 à 07:17

Bonjour,

Voilà:

9jeux-penitentiaires-2025-3-1.xlsb (259.83 Ko)

Cdlt

Le 01/08/2025 à 07:21

Bonjour Arturo83 ==> Absolument parfait....

Merci beaucoup pour tes précieuses aides !

Tu m'as fait un fichier qui tourne à merveille :-))))