Créer une CheckBox sous Visual Basic

[invited8344905]

Bonjour à toutes et à tous,

J'ai créé un bouton qui permet de créer une nouvelle ligne à la fin d'un tableau:

Sub Button111_Click()

Dim i As Integer

i = Range("A" & Rows.Count).End(xlUp).Row
Rows(i + 1).Insert

End Sub

Ici j'ai bien la création d'une nouvelle ligne à la suite de la dernière ligne de mon tableau existant.

Maintenant, je souhaiterais ajouter 4 check box. Une dans la colonne K, une en L, une en M et une en N et les 4 sur la même ligne (qui vient d'être créée via le code ci-dessus). Je précise aussi que j'utilise la version 2010 d'Excel.

Si vous avez des pistes pour créer une check box puis la positionner où il faut ça serait super

Merci d'avance,
Cordialement,

Matthieu
-----

[invite3222ab58]

bonjour mathieu,

je te montres pour la colonne "K" :

Sub Button111_Click()

Dim i As Integer

    i = Range("A" & Rows.Count).End(xlUp).Row
    Rows(i + 1).Insert
    derlign = i + 1
    Cells(derlign, "K").Select
    gauche = Cells(derlign, "K").Left
    sommet = Cells(derlign, "K").Top
    largeur = Cells(derlign, "K").Width
    hauteur = Cells(derlign, "K").Height
    ActiveSheet.CheckBoxes.Add(gauche, sommet, largeur, hauteur).Select
    

End Sub

Fred.

[invited8344905]

Bonjour Frédéric,

ça mache impécable

Merci beaucoup

[invited8344905]

Bonjour tout le monde,

J'ai une question subsidiaire: Avec ces check box insérées, je souhaite ajouter des conditions (via VBA bien sur), je me demande donc s'il ne faut pas que mes check box soient en controle ActiveX?
Je dois avouer que je ne connait pas vraiment la différence entre Active X Control et Form Control...

Cordialement,

[A voir en vidéo sur Futura]

[invite3222ab58]

bonjour mathieu,

insère tes conditions dans la macro ci dessus.
Tu n'as pas besoin de contrôle activeX.

Les contrôles formulaires sont présents pour compatibilité ascendante des anciens programmes excel.
Les active X contiennent plus de propriétés (c'est plus moderne) mais tu peux utiliser les anciens contrôles plus facile
à utiliser pour débuter.

Fred.

[invited8344905]

Re coucou,

D'abord, voici le code qui fonctionne et qui permet donc d'ajouter une ligne, 4 checkBox et lier les checkbox aux cellules visées:

Sub Button111_Click()

    Dim i As Integer
   
    'Recherche de la dernière ligne non vide du tableau
    i = Range("A" & Rows.Count).End(xlUp).Row
    'Ajout d'une ligne à la dernière ligne du tableau
    Rows(i + 1).Insert

    'Ajout des checkboxes dans les colonnes K,L,M et N
    'Indice de ligne dans une variable
    DerniereLigne = i + 1
    'Selection de la cellule colonne K, ligne ajoutée
    Cells(DerniereLigne, "K").Select
    '+28 afin de centrer la checkbox dans la cellule
    gauche = Cells(DerniereLigne, "K").Left + 28
    sommet = Cells(DerniereLigne, "K").Top
    largeur = Cells(DerniereLigne, "K").Width
    hauteur = Cells(DerniereLigne, "K").Height
    'Ajout de la checkBox
    ActiveSheet.CheckBoxes.Add(gauche, sommet, largeur, hauteur).Select
    
    With Selection
        'Ne pas afficher le nom dans la cellule
        .Caption = ""
        'Lier la CheckBox à la cellule afin de retourner la valeur
        .LinkedCell = Cells(DerniereLigne, "K").Address
    End With
    
    
    Cells(DerniereLigne, "L").Select
    gauche = Cells(DerniereLigne, "L").Left + 32
    sommet = Cells(DerniereLigne, "L").Top
    largeur = Cells(DerniereLigne, "L").Width
    hauteur = Cells(DerniereLigne, "L").Height
    ActiveSheet.CheckBoxes.Add(gauche, sommet, largeur, hauteur).Select
     With Selection
        .Caption = ""
        .LinkedCell = Cells(DerniereLigne, "L").Address
    End With
        
    Cells(DerniereLigne, "M").Select
    gauche = Cells(DerniereLigne, "M").Left + 27
    sommet = Cells(DerniereLigne, "M").Top
    largeur = Cells(DerniereLigne, "M").Width
    hauteur = Cells(DerniereLigne, "M").Height
    ActiveSheet.CheckBoxes.Add(gauche, sommet, largeur, hauteur).Select
     With Selection
        .Caption = ""
        .LinkedCell = Cells(DerniereLigne, "M").Address
    End With
    
    Cells(DerniereLigne, "N").Select
    gauche = Cells(DerniereLigne, "N").Left + 27
    sommet = Cells(DerniereLigne, "N").Top
    largeur = Cells(DerniereLigne, "N").Width
    hauteur = Cells(DerniereLigne, "N").Height
    ActiveSheet.CheckBoxes.Add(gauche, sommet, largeur, hauteur).Select
     With Selection
        .Caption = ""
        .LinkedCell = Cells(DerniereLigne, "N").Address
    End With
        
    'Ajout de la bordure sur la ligne ajoutée
    Dim cellule As Range
    For Each cellule In Range(Range("A" & i + 1), Range("N" & i + 1))
        cellule.Borders.Weight = xlThin
    Next
    
End Sub

Je souhaite ajouter 4 conditions:
1-Si je coche la checkbox dans la colonne K (1ere checkbox) alors la ligne (de la colonne A à K-1 donc colonne J) change de couleur pour la même que la colonne K
2-Si je coche la checkbox dans la colonne L (2eme checkbox) alors la ligne (de la colonne A à K-1 donc colonne J) change de couleur pour la même que la colonne L
3-ainsi de suite jusqu'à ma 4eme colonne

J'ai essayé 2 méthodes qui n'ont rien donné. La 1ere:
J'ai inséré à la suite de mon code les lignes suivantes:

Private Sub Worksheet_Change(ByVal Target As Range)
    ChgCouleur
End Sub

Et dans un module le code suivant:

Sub ChgCouleur()

    'i = Range("A" & Rows.Count).End(xlUp).Row
    'DerniereLigne = i + 1
    
    If Cells(DerniereLigne, "K").Value = True Then
        Range(Range("A" & DerniereLigne), Range("J" & DerniereLigne)).Select
        With Selection
            .Interior.ColorIndex = 5
        End With
    End If

End Sub

Lorsque je lance, j'ai une erreur sur la ligne If Cells(DerniereLigne, "K").Value = True Then et je comprend pas pourquoi...

Sinon la seconde méthode que j'ai essayé:

J'ai inséré ça à la suite du code principal

Private Sub CheckBox302_Click()

    If CheckBox302.Value = True Then
        Range("A" & i + 1).Activate
        With Selection.Interior
            .ColorIndex = 35
        End With
    End If
End Sub

Le soucis ici c'est que je maitrise pas le nom des checkbox insérées car à chaque ajout de ligne le nom incrémente de 1 le chiffre qui suit "CheckBox". Bref j'ai testé avec le nom de ma checkbox = CheckBox302, ça ne fonctionne pas non plus...

Je précise que les conditions à afficher ne dépendent pas du boutton d'ajout de ligne mais de l'état des checkboxes ajoutées donc je ne vois pas comment procéder

Si qqun à une idée je suis preneur.

Bisou

[invite3222ab58]

bonsoir mathieu,
je viens de changer ton prog regarde :

Sub Button111_Click()

    Dim i As Integer
   
    'Recherche de la dernière ligne non vide du tableau
    i = Range("A" & Rows.Count).End(xlUp).Row
    'Ajout d'une ligne à la dernière ligne du tableau
    Rows(i + 1).Insert

    'Ajout des checkboxes dans les colonnes K,L,M et N
    'Indice de ligne dans une variable
    derniereligne = i + 1
    'Selection de la cellule colonne K, ligne ajoutée
    Cells(derniereligne, "K").Select
    '+28 afin de centrer la checkbox dans la cellule
    gauche = Cells(derniereligne, "K").Left
    sommet = Cells(derniereligne, "K").Top
    largeur = Cells(derniereligne, "K").Width
    hauteur = Cells(derniereligne, "K").Height
    'Ajout de la checkBox
    ActiveSheet.CheckBoxes.Add(gauche, sommet, largeur, hauteur).Select
    
    With Selection
        'Ne pas afficher le nom dans la cellule
        .Caption = ""
        'Lier la CheckBox à la cellule afin de retourner la valeur
        .LinkedCell = ""
        .Name = "cbK" & Format$(derniereligne)
        .OnAction = "couleur"
    End With
    
    
    Cells(derniereligne, "L").Select
    gauche = Cells(derniereligne, "L").Left
    sommet = Cells(derniereligne, "L").Top
    largeur = Cells(derniereligne, "L").Width
    hauteur = Cells(derniereligne, "L").Height
    ActiveSheet.CheckBoxes.Add(gauche, sommet, largeur, hauteur).Select
     With Selection
        .Caption = ""
        .LinkedCell = ""
        .Name = "cbL" & Format$(derniereligne)
        .OnAction = "couleur"
    End With
        
    Cells(derniereligne, "M").Select
    gauche = Cells(derniereligne, "M").Left
    sommet = Cells(derniereligne, "M").Top
    largeur = Cells(derniereligne, "M").Width
    hauteur = Cells(derniereligne, "M").Height
    ActiveSheet.CheckBoxes.Add(gauche, sommet, largeur, hauteur).Select
     With Selection
        .Caption = ""
        .LinkedCell = ""
        .Name = "cbM" & Format$(derniereligne)
        .OnAction = "couleur"
    End With
    
    Cells(derniereligne, "N").Select
    gauche = Cells(derniereligne, "N").Left
    sommet = Cells(derniereligne, "N").Top
    largeur = Cells(derniereligne, "N").Width
    hauteur = Cells(derniereligne, "N").Height
    ActiveSheet.CheckBoxes.Add(gauche, sommet, largeur, hauteur).Select
     With Selection
        .Caption = ""
        .LinkedCell = ""
        .Name = "cbN" & Format$(derniereligne)
        .OnAction = "couleur"
    End With
        
    'Ajout de la bordure sur la ligne ajoutée
    Dim cellule As Range
    For Each cellule In Range(Range("A" & i + 1), Range("N" & i + 1))
        cellule.Borders.Weight = xlThin
    Next
    
End Sub

et voici la suite le nouveau code :

Sub couleur()
        For Each sh In ActiveSheet.Shapes
        sh.Select
        nomcb$ = Selection.Name
        valcb = Selection.Value
        libcol$ = "": numlign = 0
            If valcb = 1 Then
            libcol$ = Mid$(nomcb$, 3, 1)
            numlign = Val(Right$(nomcb$, Len(nomcb$) - 3))
            Cells(1, libcol$).Select
            coulsource = Selection.Interior.Color
            .........
            .........
            .........
            End If
        Next sh
End Sub

Maintenant à la place des points il faut que tu vois comment réaffecter le numéro de couleur trouvé
au 'range' que tu veux.


Fred.

[invited8344905]

Bonjour Frederic,

Dans un premier temps merci pour ton aide.

Je peux voir qu'on a pas du tout le même niveau en VBA et c'est pas très clair pour moi d'où les questions suivantes:
- Pourquoi avoir retiré le contenu de .LinkedCell? Si c'est vraiment pas necessaire vu le code qu'il y a après je peux retirer directement cette ligne de code et alléger le programme?

- Sur le "Sub couleur()", la variable "valcb" devrait soit être "True" ou "False" vu que c'est la valeur d'une Cbox nan?
A vrai dire je comprends pas grand chose au Sub couleur(). Je vais avoir du mal à le compléter si je ne le comprend pas. Penses tu avoir un peu de temps pour me l'expliquer?


Sinon, j'ai testé le programme sans le Sub couleur() et les .OnAction, ça marche impec par contre lorsque je lui demande d'afficher le nom enregistré dans .Name (avec Msgbox) il me retourne le nom de l'onglet excel alors qu'il devrait sortir un truc du genre cbX (avec X = K ou L ou M ou N selon la position du code Msgbox) suivi du numéro de ligne...

Cordialement,
Matthieu

[invited8344905]

Coucou le forum,

Alors ayé, j'arrive à faire changer mes lignes de couleur. J'ai modifié un peu ton code Fred:

Sub couleur()

    For Each sh In ActiveSheet.Shapes
        If sh.Name <> "Button 111" Then
            sh.Select
            nomcb$ = Selection.Name
            'MsgBox (nomcb$)
            valcb = Selection.Value
            'MsgBox (valcb)
            libcol$ = "": numlign = 0
            If valcb = 1 Then
                libcol$ = Mid$(nomcb$, 3, 1)
                numlign = Val(Right$(nomcb$, Len(nomcb$) - 3))
                Cells(1, libcol$).Select
                coulsource = Selection.Interior.Color
                Range(Range("A" & numlign), _
                Range("J" & numlign)).Interior.Color = coulsource
            End If
        End If
    Next sh
End Sub

J'ai mis ceci dans un module et j'ai rajouté une exeption pour mon bouton d'ajout de ligne qu'il considère comme un Shape du coup j'avais un bug. Donc pour cet onglet ça marche.

Sur mon Excel, j'ai 5 onglets et je souhaite faire la même macro pour chaque onglet. J'ai donc inséré 4 autres boutons (1 par onglet) et affecté la macro. Par contre j'ai tenté d'utiliser la fonction OU dans le SI pour qu'il ne me prenne pas les boutons d'ajout de ligne pour affecter les couleurs ce qui donne:

Sub couleur()

    For Each sh In ActiveSheet.Shapes
        If sh.Name <> "Button 111" Or sh.Name <> "Button 225" Or _
        sh.Name <> "Button 146" Or sh.Name <> "Button 89" Or _
        sh.Name <> "Button 81" Then            
            sh.Select
            nomcb$ = Selection.Name
            'MsgBox (nomcb$)
            valcb = Selection.Value
            'MsgBox (valcb)
            libcol$ = "": numlign = 0
            If valcb = 1 Then
                libcol$ = Mid$(nomcb$, 3, 1)
                numlign = Val(Right$(nomcb$, Len(nomcb$) - 3))
                Cells(1, libcol$).Select
                coulsource = Selection.Interior.Color
                Range(Range("A" & numlign), _
                Range("J" & numlign)).Interior.Color = coulsource
            End If
        End If
    Next sh
End Sub

Mais quand je lance j'ai un pop-up "Run-time error '438' object doesn't support this property or method" et la ligne valcb = Selection.Value se met en jaune lorsque je debug.

Je comprends pas pourquoi lorsque je rajoute la fonction OU ça ne fonctionne plus.

Besoin de lumière...

@+

[invited8344905]

C'est encore moi

J'ai résolu mon problème en changeant la fonction OU par une ET vu que je regarde si c'est différent.

J'ai également ajouté un paragraphe (en rouge) car si je décoche mes checkboxes je souhaite que le fond de la cellule redevienne blanc (ou du moins sans couleur...) cela fonctionne plus ou moins car j'ai un pop-up d'erreur (Run-time error '1004': Method 'Range' of object '_Global' failed)

Sub couleur()

    For Each sh In ActiveSheet.Shapes
        
        If sh.Name <> "Button 111" And sh.Name <> "Button 225" And sh.Name <> "Button 146" And sh.Name <> "Button 89" And sh.Name <> "Button 81" Then
            sh.Select
            nomcb$ = Selection.Name
            valcb = Selection.Value
            libcol$ = "": numlign = 0
            
            If valcb <> 1 Then
                libcol$ = Mid$(nomcb$, 3, 1)
                numlign = Val(Right$(nomcb$, Len(nomcb$) - 3))
                Cells(1, libcol$).Select
                coulsource = RGB(255, 255, 255)
                Range(Range("A" & numlign), _
                Range("J" & numlign)).Interior.Color = coulsource
            End If            
            
            If valcb = 1 Then
                libcol$ = Mid$(nomcb$, 3, 1)
                numlign = Val(Right$(nomcb$, Len(nomcb$) - 3))
                Cells(1, libcol$).Select
                coulsource = Selection.Interior.Color
                Range(Range("A" & numlign), _
                Range("J" & numlign)).Interior.Color = coulsource
            End If
        
        End If
    
    Next sh
    
End Sub

Si quelqu'un à une idée là dessus je suis preneur

Merci d'avance.

[invite3222ab58]

Bonsoir mathieu

Effectivement je vois que tu es débutant en macro.

C'est ta fonction RGB qui ne veut rien dire , utilise les bonnes fonctions .

Celle que tu cherches est :

If valcb <> 1 Then
            numlign = Val(Right$(nomcb$, Len(nomcb$) - 3))
            Range(Range("A" & numlign), Range("J" & numlign)).Select
                With Selection.Interior
                .Pattern = xlNone
                .TintAndShade = 0
                .PatternTintAndShade = 0
                End With
        
        End If

Fred.