Conserver la même checkbox sur toutes les lignes

Créer une discussion
Répondre

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
S

siocnarf

XLDnaute Occasionnel
Bonjour,

Je suis à créer un classeur avec plusieurs checkbox sur une même ligne. J'associe des VBA à ces checkbox afin que des valeurs soient associés en fonction que la checkbox est coché ou pas.

Ma problématique est que chaque ligne correspond à un incident. Donc au fur et à mesure que de nouveaux incidents sont créés, je veux réutiliser les checkbox de la ligne précédent.

1. Comment aisément copier tous les checkbox d'une ligne sur la ligne du dessous?
2. Comment réutiliser les checkbox d'une ligne à l'autre?
3. Y-a-t-il une manière de décocher tous les checkbox d'un classeur d'un coup?

Code: 
Private Sub CheckBox1_Click()
With ActiveSheet.Shapes("Checkbox1").TopLeftCell
    nligne = .Row
    ncolonne = .Column
    sAddresse = .Address
End With
'Valeur de la réponse quand la case est cochée
nvaleur = 20
'Colonne à côté signifie +1 ou 1
nemplacementvaleur = 1
Call setvaleur(nligne, ncolonne, nvaleur, nemplacementvaleur)
End Sub

Private Sub setvaleur(S_nligne, S_ncolonne, S_nvaleur, S_nemplacementvaleur)
S_celloutput = Cells(S_nligne, S_ncolonne + S_nemplacementvaleur).Address
'(RowAbsolute:=False, ColumnAbsolute:=False)
If CheckBox1.Value = True Then Range(S_celloutput).Value = S_nvaleur
If CheckBox1.Value = False Then Range("C4").Value = 0
End Sub

En pièce jointe un exemple de fichier avec les cases à cocher.

Merci pour votre aide,

François Racine
 

Pièces jointes

Trier par date Trier par votes
Re : Conserver la même checkbox sur toutes les lignes

Bonsoir siocnarf,

Je préfère utiliser à la place des checkbox des caractères de remplacement affublés de la police WingDings. Le caractère de code 111 représente une case non cochée et le caractère de code 254 représente une case cochée.

Pour cocher/décocher une case, on utilise le double-clique sur la cellule (qu'on pourrait remplacer par le clique droit)

Le code pour cocher/décocher une case se trouve dans le module de code de la feuille "Feuil1". Il permet de cocher ou décocher une case ainsi que d'entreprendre les actions induites.

Le module "Module2" comporte une procédure ajouter_incident qui permet d'ajouter un incident. Cette procédure est déclenchée quand on clique sur le bouton "insérer Incident" sur la feuille "Feuil1".

Le code dans le module de "Feuil1":
VB: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If Target.Font.Name = "Wingdings" Then
  'on passe de coché à décoché et vice-versa
  Target = IIf(Target = Chr(PasCoche), Chr(Coche), Chr(PasCoche))
  Cancel = True
  Select Case Target.Column
    ' si colonne B
    Case Range("B1").Column
      Target.Offset(0, 1) = IIf(Target = Chr(Coche), 20, "")
    ' si colonne D
    Case Range("D1").Column
       If Target = Chr(Coche) Then MsgBox ("Aller porter plainte")
    ' si colonne E
    Case Range("E1").Column
      Target.Offset(0, 1) = IIf(Target = Chr(Coche), "Pas bien", "")
    ' si colonne G
    Case Range("G1").Column
      Target.Offset(0, 1) = IIf(Target = Chr(Coche), "tête de linotte", "")
  End Select
End If

End Sub

Le code d'insertion d'un incident dans module2:
VB: 
Option Explicit

Public Const PasCoche = 111
Public Const Coche = 254

Sub ajouter_incident()
Dim xrg As Range

With Sheets("Feuil1")
  Set xrg = .Range("A" & Rows.Count).End(xlUp)
  xrg.Resize(1, 8).Copy xrg.Offset(1)
  xrg.Offset(1, 0) = xrg + 1
  xrg.Offset(1, 1) = Chr(PasCoche)
  xrg.Offset(1, 2) = ""
  xrg.Offset(1, 3) = Chr(PasCoche)
  xrg.Offset(1, 4) = Chr(PasCoche)
  xrg.Offset(1, 5) = ""
  xrg.Offset(1, 6) = Chr(PasCoche)
  xrg.Offset(1, 7) = ""
  xrg.Offset(1).EntireRow.RowHeight = xrg.EntireRow.RowHeight
End With

End Sub

nota: Voir fichier v2 (avec option raz et une petite correction du v1) dans message suivant #3
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Conserver la même checkbox sur toutes les lignes

(re) Bonsoir siocnarf,

Avec l'option de RAZ de toutes les Checkbox + une correction du précédent fichier.

Le code de la procédure raz dans module2:
VB: 
Sub raz()
Dim xrg As Range

If MsgBox("Etes vous certain de vouloir décocher toutes les checkBox ?", _
    Buttons:=vbDefaultButton2 + vbYesNo + vbQuestion) = vbYes Then
  With Sheets("Feuil1")
    Set xrg = .Range("A" & Rows.Count).End(xlUp)
    Set xrg = .Range(.Range("A4"), xrg)
    xrg.Offset(0, 1) = Chr(PasCoche)
    xrg.Offset(0, 2) = ""
    xrg.Offset(0, 3) = Chr(PasCoche)
    xrg.Offset(0, 4) = Chr(PasCoche)
    xrg.Offset(0, 5) = ""
    xrg.Offset(0, 6) = Chr(PasCoche)
    xrg.Offset(0, 7) = ""
  End With
End If
End Sub
 

Pièces jointes

Vote positif 0 Vote négatif
Re : Conserver la même checkbox sur toutes les lignes

Bonjour siocnarf,

L'instruction qui coche/décoche se trouve dans la macro évènementielle Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean).

On regarde d'abord si la cellule sur laquelle on a double-cliqué (Target) est en police Wingdings
If Target.Font.Name = "Wingdings" Then

Si oui alors on change l'état de la cellule par l'instruction:
Target = IIf(Target = Chr(PasCoche), Chr(Coche), Chr(PasCoche)) qui peut s'interpréter comme suit:

Si Target est égal au caractère Chr(PasCoche) alors on place dans Target le caractère Chr(Coche) sinon on y place le caractère Chr(PasCoche).

Ensuite, en fonction de la colonne de Target, via le select (Select Case Target.Column... End Select), on fait ce qui est à faire selon le nouvel état de Target (coché ou non).
 
Vote positif 0 Vote négatif
Re : Conserver la même checkbox sur toutes les lignes

Bonjour,

Je me permets de vous relancer. Votre macro fonctionne très bien mais cela m'amène une problématique.
Cela fait un case extrèmement long et si j'ajoute une colonne alors toute la numérotation est à recorriger. Comment pourrais-je contourner ce problème?

Code: 
Option Explicit

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

If Target.Font.Name = "Wingdings" Then
  'on passe de coché à décoché et vice-versa
  Target = IIf(Target = Chr(PasCoche), Chr(Coche), Chr(PasCoche))
  Cancel = True
  Select Case Target.Column
    Case Range("B1").Column
      Target.Offset(0, 1) = IIf(Target = Chr(Coche), 20, "")
    Case Range("D1").Column
       ' Colonne D - Vol
       'If Target = Chr(Coche) Then MsgBox ("Aller porter plainte")
       Target.Offset(0, 1) = IIf(Target = Chr(Coche), 15, "")
    Case Range("F1").Column
      Target.Offset(0, 1) = IIf(Target = Chr(Coche), 10, "")
    Case Range("H1").Column
        'Colonne H - Perte
      Target.Offset(0, 1) = IIf(Target = Chr(Coche), 10, "")
    Case Range("K1").Column
      Target.Offset(0, 1) = IIf(Target = Chr(Coche), 20, "")
    Case Range("M1").Column
      Target.Offset(0, 1) = IIf(Target = Chr(Coche), 10, "")
    Case Range("O1").Column
      Target.Offset(0, 1) = IIf(Target = Chr(Coche), 5, "")
    Case Range("R1").Column
      Target.Offset(0, 1) = IIf(Target = Chr(Coche), 20, "")
    Case Range("T1").Column
      Target.Offset(0, 1) = IIf(Target = Chr(Coche), 20, "")
    Case Range("V1").Column
      Target.Offset(0, 1) = IIf(Target = Chr(Coche), 20, "")
    Case Range("X1").Column
      Target.Offset(0, 1) = IIf(Target = Chr(Coche), 20, "")
    Case Range("Z1").Column
      Target.Offset(0, 1) = IIf(Target = Chr(Coche), 20, "")
    Case Range("AB1").Column
      Target.Offset(0, 1) = IIf(Target = Chr(Coche), 20, "")
    Case Range("AE1").Column
      Target.Offset(0, 1) = IIf(Target = Chr(Coche), -100, "")
    Case Range("AG1").Column
        'Colonne AG -  100 et plus
      Target.Offset(0, 1) = IIf(Target = Chr(Coche), 20, "")
    Case Range("AI1").Column
        'Colonne AI -  De 11 à 100
      Target.Offset(0, 1) = IIf(Target = Chr(Coche), 10, "")
    Case Range("AK1").Column
        'Colonne AK -  De 1 à 10
      Target.Offset(0, 1) = IIf(Target = Chr(Coche), 5, "")
    Case Range("AN1").Column
        'Colonne AN -  100 et plus
      Target.Offset(0, 1) = IIf(Target = Chr(Coche), 20, "")
    Case Range("AP1").Column
        'Colonne AP -  De 11 à 100
      Target.Offset(0, 1) = IIf(Target = Chr(Coche), 10, "")
    Case Range("AR1").Column
        'Colonne AR -  De 1 à 10
      Target.Offset(0, 1) = IIf(Target = Chr(Coche), 5, "")
    Case Range("AU1").Column
      Target.Offset(0, 1) = IIf(Target = Chr(Coche), -215, "")
   Case Range("AW1").Column
      Target.Offset(0, 1) = IIf(Target = Chr(Coche), -25, "")
   Case Range("AY1").Column
      Target.Offset(0, 1) = IIf(Target = Chr(Coche), -20, "")

  End Select
End If

End Sub

Merci,

François
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

N
  • Résolu(e)
Microsoft 365 Simplifier un code pour activer ou désactiver des CheckBox
6 7 8
Réponses
115
Affichages
4 K
ChTi160
ChTi160
cathodique
  • Résolu(e)
XL 2010 inhiber evenement
Réponses
13
Affichages
573
cathodique
cathodique
C
  • Question Question
Microsoft 365 worksheet_change
2
Réponses
29
Affichages
488
CortoXls
C
T
  • Résolu(e)
XL 2019 Filtrer certains champs au démarrage avec vba
2
Réponses
15
Affichages
498
telemarrk
T
thunder23
  • Résolu(e)
XL 2021 Bug dans code vba
Réponses
8
Affichages
316
thunder23
thunder23
N
  • Résolu(e)
Microsoft 365 Recherche dans un tableau structuré à partir d'une TextBox
Réponses
11
Affichages
583
NONO14
N
F
  • Question Question
Microsoft 365 Associer lancement macro à une CheckBox
Réponses
7
Affichages
904
Fab117
F
T
  • Résolu(e)
XL 2016 macro et feuille protégé
2
Réponses
18
Affichages
922
laurent950
laurent950
M
  • Question Question
Microsoft 365 Erreur sur mon Code VBA
Réponses
2
Affichages
515
Gégé-45550
Gégé-45550
R
  • Question Question
XL 2019 Demande à la macro de chercher et de remplir automatiquement jusqu'à la dernière valeur
Réponses
1
Affichages
508
Aya_flo
A
Y
  • Résolu(e)
XL 2013 Surligner une ligne si curseur sur la ligne et dans une zone définie
Réponses
2
Affichages
471
Yvan1
Y
oguruma
EXCEL :: Les Tableaux Structurés :: Une classe VBA pour mieux les gérer - V1.02
Réponses
4
Affichages
373
bsalv
B
F
  • Question Question
XL 2019 l'indice n'appartient pas à la sélection
Réponses
9
Affichages
820
job75
job75
T
  • Résolu(e)
XL 2019 Gestion "pseudo-évènements" sur un userform
2
Réponses
15
Affichages
957
ThierryP
T
E
  • Résolu(e)
Microsoft 365 Boucle sur lignes <>0
Réponses
2
Affichages
401
eric72
E
oguruma
EXCEL :: Les Tableaux Structurés :: Une classe VBA - V1.05 - Evolutions majeures exports CSV, XML, XML UTF-8, JSON, HTML, PDF, JPG, JPEG, BMP, EXCEL
Réponses
10
Affichages
427
oguruma
oguruma
G
  • Question Question
XL 2016 Extraire des données d'un pdf et les copier dans excel
2
Réponses
19
Affichages
2 K
kiki29
kiki29
L
  • Question Question
XL 2021 Comment utiliser la colonne d'une adresse en Private Sub - svp ?
Réponses
3
Affichages
506
vgendron
vgendron
G
  • Question Question
Microsoft 365 Avoir des classeurs maitres et les procédures dans un autre classeur.
2
Réponses
19
Affichages
2 K
GClaire
G
N
  • Résolu(e)
Microsoft 365 Rechercher la dernière cellule saisie dans un TS et ajouter l'heure système
18 19 20
Réponses
297
Affichages
69 K
NONO14
N
Retour