Checkbox dans une macro

Résolu
mstecluque Messages postés 73 Date d'inscription   Statut Membre Dernière intervention   -  
f894009 Messages postés 17413 Statut Membre -
Bonjour à tous,

J'ai créé une macro fait pleins de chaose et notamment qui ajoute des checkboxes à chaque ligne d'un fichier.
Je voudrais supprimer une ligne si la checkbox correspondante est sélectionnée.

J'ai tenté plusieurs méthodes, mais rien ne marche.
J'ai même essayé d'enregistrer une macro où je cochais des cases mais la macro reste vide.
Concrètement je ne sais plus comment faire même la doc de microsoft ne marche pas. Je dois sûrement être à côté de la plaque.
Je vous mets le lien.
https://docs.microsoft.com/en-us/dotnet/api/system.windows.forms.checkbox.checked?redirectedfrom=MSDN&view=netframework-4.8

Je vous mets mon bout de code qui concerne ça : 

'création des checkboxes
For liFM = lidebFM To lifinFM + 1
    With Sheets(FM).Cells(liFM, cofinFM + 1)
        .Select
        ActiveSheet.CheckBoxes.Add(.Left, .Top, .Width, .Height).Select
    End With
    With Selection
        .Characters.Text = ""
    End With
Next liFM

'et beaucoup plus loin dans le code, supppression si cochée
If Sheets(FM).CheckBox.Checked = True Then
        Rows(liFM).Select
        Selection.Delete Shift:=xlUp
        liFM = liFM - 1
    End If


Et macro complète: 

Option Explicit                                 'force la déclaration des variables
Option Base 1                                   'pour commencer l'index des tableaux à 1 au lieu de 0

Public Const FS = "Suivi des commandes"         'déclare comme constante FS pour Suivi de commandes
Const lidebFS = 5                               'déclare comme constante la ligne 5 comme ligne de début de parcours pour la feuille FS
Const coId = "A"                                'déclare comme constante la colonne A pour la colonne des identifiants
Const coDL = "W"                                'déclare comme constante la colonne W pour la colonne de Date de livraison réelle
Const coProb = "AK"                             'déclare comme constante la colonne Y pour la colonne de Problème à signaler
Const coProbA = "AL"                            'déclare comme constante la colonne Z pour la colonne de Problème déjà affiché


Public Const FM = "Commandes2"                  'déclare comme constante FM pour Mise à jour Commandes
Public Const lidebFM = 2                        'déclare comme constante la ligne 3 comme ligne de début de parcours pour la feuille FM
Public Const codebFM = 1                        'déclare comme constante la colonne 1 comme colonne de début de parcours pour la feuille FM
Public Const cofinFM = 8                        'déclare comme constante la colonne 8 comme colonne de fin de parcours pour la feuille FM
Const coDLFM = "F"
Const coulNouv = 23                             'déclare comme constante la couleur de fond bleu en cas de nouveauté
Const coulPb = 22                               'déclare comme constante la couleur de fond rouge en cas de problème



Public Sub MAJ_Commandes2()

Dim liFS As Long                                'déclare la variable liFS (incrément)
Dim lifinFS As Long                             'déclare la variable ligne de fin de FS

Dim id As Long                                  'déclare l'identifiant

Dim liFM As Long                                'déclare la variable liFM (incrément)
Dim lifinFM As Long                             'déclare la variable ligne de fin de FM
Dim coFM As Long                                'déclare la variable coFM (incrément)

Dim objFM As Object                             'déclare l'objet FM
Dim liObjFM As Long                             'déclare la variable liObjFM (incrément)

Dim TcoFS()                                     'déclare la variable TcoFS (tableau des colonnes FS)


'--Début de la macro
'Arrêt du rafraîchissement de l'écran (augmente la rapidité de la macro)
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

'Liste des n° de colonnes dans FS qui sont dans FM
TcoFS = Array(1, 3, 6, 16, 17, 23, 25, 37)

'Dernières lignes de FS et FM
lifinFS = Sheets(FS).Cells(Rows.Count, 1).End(xlUp).Row
lifinFM = Sheets(FM).Cells(Rows.Count, 1).End(xlUp).Row

'On appelle la fonction effacement
Call clear_tab

'On parcourt toutes les lignes de FS
For liFS = lidebFS To lifinFS
    'On donne la valeur de l'identificateur de cette ligne à id
    id = Sheets(FS).Cells(liFS, coId).Value
    
    'Recherche de id dans colonne coId de FM
    Set objFM = Sheets(FM).Columns(coId).Find(id, , , xlWhole)

    If Sheets(FS).Cells(liFS, coProbA).Value = "" Then
        'Si on ne trouve pas l'ID
        If objFM Is Nothing Then
        
            'Si la date de livraison est la date du jour ou une date postérieure
            If Sheets(FS).Cells(liFS, coDL).Value = Date Or Sheets(FS).Cells(liFS, coDL).Value = "" Then
            
                'On copie cet id dans FM
                lifinFM = Sheets(FM).Cells(Rows.Count, 1).End(xlUp).Row
                'Et pour chaque colonne de FM
                For coFM = 1 To cofinFM
                On Error GoTo GestionnaireErreur
                    Sheets(FS).Cells(liFS, TcoFS(coFM)).Copy
                    Sheets(FM).Cells(lifinFM + 1, coFM).PasteSpecial Paste:=xlPasteValues
                Next coFM
                For coFM = 1 To cofinFM
                    If Sheets(FM).Cells(lifinFM + 1, cofinFM).Value = "" Then
                        Sheets(FM).Cells(lifinFM + 1, coFM).Interior.ColorIndex = coulNouv
                    Else
                        Sheets(FM).Cells(lifinFM + 1, coFM).Interior.ColorIndex = coulPb
                    End If
                Next coFM
                
            End If

        ' si id trouve modification+couleur éventuelle de cet id dans FM
        Else
        
            ' ligne de id dans FM
            liObjFM = objFM.Row
            ' boucle sur les colonnes de FM
            For coFM = 1 To cofinFM
                ' si données différentes on colorie la cellule
                If Sheets(FS).Cells(liFS, TcoFS(coFM)).Value <> Sheets(FM).Cells(liObjFM, coFM).Value Then
                    ' on copie la cellule
                    Sheets(FS).Cells(liFS, TcoFS(coFM)).Copy
                    Sheets(FM).Cells(liObjFM, coFM).PasteSpecial Paste:=xlPasteValues
                    If Sheets(FM).Cells(liObjFM, cofinFM).Value <> "" Then
                        Sheets(FM).Range(Cells(liObjFM, 1), Cells(liObjFM, coFM)).Interior.ColorIndex = coulPb
                    Else
                        Sheets(FM).Cells(liObjFM, coFM).Interior.ColorIndex = coulNouv
                    End If
                Else
                    ' on copie la cellule, dans tous les cas
                    Sheets(FS).Cells(liFS, TcoFS(coFM)).Copy
                    Sheets(FM).Cells(liObjFM, coFM).PasteSpecial Paste:=xlPasteValues
                End If
                
            Next coFM
        End If


    End If
        If Sheets(FS).Cells(liFS, coProb).Value <> "" And Sheets(FS).Cells(liFS, coProbA).Value = "" Then
            Sheets(FS).Cells(liFS, coProbA).Value = 1
        ElseIf Sheets(FS).Cells(liFS, coProbA).Value <> "" Then
            Sheets(FS).Cells(liFS, coProbA).Value = Sheets(FS).Cells(liFS, coProbA).Value + 1
        End If
Next liFS

For liFM = lidebFM To lifinFM + 1
    With Sheets(FM).Cells(liFM, cofinFM + 1)
        .Select
        ActiveSheet.CheckBoxes.Add(.Left, .Top, .Width, .Height).Select
    End With
    With Selection
        .Characters.Text = ""
    End With
Next liFM

GestionnaireErreur:
    If liFS <> lifinFS + 1 Then
        MsgBox "Problème de données dans le fichier Achats à la ligne " & liFS & " de Suivi des commandes", vbExclamation, "Attention"
        Exit Sub
    End If
'Redémarrage du rafraîchissement de l'écran
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

'Fonction de nettoyage du tableau de FM
Sub clear_tab()

'Déclarations des données
Dim liFM As Long, lifinFM As Long

'On enlève le filtre s'il y en a un
'Selection.AutoFilter

'Dernière ligne de FM
lifinFM = Sheets(FM).Cells(Rows.Count, 1).End(xlUp).Row
'On parcourt toutes les lignes de FM
For liFM = lidebFM To lifinFM
    'On enlève le fond coloré
    Rows(liFM).Interior.ColorIndex = xlNone
    'On enlève la ligne si date livraison>AUJOURDHUI
    If Sheets(FM).Cells(liFM, coDLFM).Value < Date And Sheets(FM).Cells(liFM, coDLFM).Value <> "" Then
        Rows(liFM).Delete Shift:=xlUp
        liFM = liFM - 1
    End If
    'On enlève la ligne si la case est cochée
    If Sheets(FM).CheckBox.Checked = True Then
        Rows(liFM).Select
        Selection.Delete Shift:=xlUp
        liFM = liFM - 1
    End If
Next liFM
End Sub


Si qqun a une idée, merci d'avance.

A voir également:

3 réponses

Réponse 1 / 3
f894009 Messages postés 17413 Statut Membre 1 715
 
Bonjour,

Le code que vous avez recupere, en parti, est pour des checkboxs Control Activex pas pour control de formulaire sur feuille de calcul. Mais ca vous a cree quand meme des controls de formulaire

Les checkboxs control de formulaire sur feuille de calcul sont des "betes a chagrin", et vous en avez (il me semble) une par ligne: 

    'On enlève la ligne si la case est cochée
    If Sheets(FM).Shapes("Check Box " & liFM).OLEFormat.Object.Value = xlOn Then
        Rows(liFM).Select
        Selection.Delete Shift:=xlUp
        liFM = liFM - 1
    End If
1
mstecluque Messages postés 73 Date d'inscription   Statut Membre Dernière intervention  
 
Je ne comprends pas tout, mais si le code que vous avez mis est censé marcher, ce n'est pas le cas du tout...
0
f894009 Messages postés 17413 Statut Membre 1 715 > mstecluque Messages postés 73 Date d'inscription   Statut Membre Dernière intervention  
 
Re,
ce n'est pas le cas du tout... Y a des erreurs ????????????????
Il marche chez moi sur excel2013.

A defaut, mettez votre fichier a dispo
0
mstecluque Messages postés 73 Date d'inscription   Statut Membre Dernière intervention  
 
Ca me met une erreur d'exécution avec un numéro que je n'avais jamais vu jusque là :
'-2147024809 (80070057)': L'élément portant ce nom est introuvable.
Et ça me renvoie sur la ligne 
If Sheets(FM).Shapes("Check Box " & liFM).OLEFormat.Object.Value = xlOn Then
0
Réponse 2 / 3
ThauTheme Messages postés 1564 Statut Membre 160
 
Bonjour le fil, bonjour le forum,

Juste une remarque... Pourquoi ne pas utiliser tout simplement une colonne du tableau et y mettre "X" ou "x" plutôt que de s'embarquer dans un code compliqué qui va alourdir considérablement le fichier et ralentir l'exécution du code ?... Bien sûr esthétiquement c'est différent mais parfois la simplicité prévaut sur l'esthétisme...
0
f894009 Messages postés 17413 Statut Membre 1 715
 
Bonjour,

C'est pas faux!!

ou un truc simple: 
'police cellules: Winsdings2
'test si coche: "R"
'test si pas coche: "£"
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
  If Not Application.Intersect(Target, Range("A2:A32")) Is Nothing Then
    Cancel = True
    If ActiveCell.Value = "R" Then
      ActiveCell.Value = "£"
    ElseIf ActiveCell.Value = "" Or ActiveCell.Value = "£" Then
      ActiveCell.Value = "R"
    End If
  End If
End Sub
0
mstecluque Messages postés 73 Date d'inscription   Statut Membre Dernière intervention   > f894009 Messages postés 17413 Statut Membre
 
Personnellement je ne comprends pas le truc simple. Je ne vois pas trop comment l'intégrer à ma macro.
Et le coup des croix c'est pas idiot, mais je pense pas que ça plaise aux autres utilisateurs.
0
f894009 Messages postés 17413 Statut Membre 1 715 > mstecluque Messages postés 73 Date d'inscription   Statut Membre Dernière intervention  
 
Re,

Personnellement je ne comprends pas le truc simple. Ce code est a mettre dans le VBA de la feuile en adaptant la colonne. Clic droit sur une cellule

fichier exemple: https://www.cjoint.com/c/EGkl0NuPqxL


Pour l'erreur, quand vous l'avez, passez le curseur souris sur les variables de la ligne pour voir leur valeur.

Quand vous cliquer sur une case a cocher, qu'est-ce qu'il y a d'ecrit dans la zone de texte ou s'affiche les noms de cellule
0
mstecluque Messages postés 73 Date d'inscription   Statut Membre Dernière intervention  
 
Je n'ai toujours pas compris comment ça marche, mais je trouve ça génial.

Pour moi, les variables ont l'air bonnes: FM correspond à la bonne feuille, liFM à la bonne ligne et xlOn =1
Donc ça vient du reste, mais je sais pas d'où...
0
mstecluque Messages postés 73 Date d'inscription   Statut Membre Dernière intervention  
 
Ensuite je ne vois pas où est censé s'afficher le nom des cellules...
0
Réponse 3 / 3
mstecluque Messages postés 73 Date d'inscription   Statut Membre Dernière intervention  
 
Je viens de percuter le premier commentaire...
Je dois le dire, c'est encore plus génial que ce que je pensais!
0
f894009 Messages postés 17413 Statut Membre 1 715
 
Re,

Je dois le dire, c'est encore plus génial que ce que je pensais! Oui, mais,

Que faisons pour vos case a cocher ???
0
mstecluque Messages postés 73 Date d'inscription   Statut Membre Dernière intervention  
 
bon alors concrètement je suis en train d'essayer d'intégrer ce petit bout de code à ma macro. Je galère un peu puisque je passe du code d'une feuille à celui d'un module.
Mais je pense que je vais faire comme ça, avec un clic gauche pour plus de simplicité.
Il faut juste que j'y arrive.
Et après je testerai le contenu de la cellule plutôt qu'une checkbox.
0
f894009 Messages postés 17413 Statut Membre 1 715 > mstecluque Messages postés 73 Date d'inscription   Statut Membre Dernière intervention  
 
Re,

C'est vous qui voyez

Pour l'erreur que vous ne connaissiez pas, 
If Sheets(FM).Shapes("Check Box " & liFM).OLEFormat.Object.Value = xlOn Then

cela vient du fait que la case a cocher n'existe pas, soit un probleme avec liFM et le nom des cases a cocher ou ce n'est pas le bon control
0
mstecluque Messages postés 73 Date d'inscription   Statut Membre Dernière intervention  
 
Du coup, ça marche, très bien même. Donc merci beaucoup!
Le seul problème que je rencontre, c'est que je ne veux pas définir un nombre de ligne précis. Je veux que ça s'applique s'il y a une valeur dans la première colonne.
Mais du coup ça ne marche pas avec ma condition.
J'ai tellement le nez dedans que je n'arrive plus à rien.
Donc si qqun voit pourquoi, ça m'évitera une heure supp... 

'police cellules: Winsdings2
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)

Dim codebFM As Long
If ActiveCell.Offset(0, 8).Value <> "" Then
  If Not Application.Intersect(Target, Range("I:I")) Is Nothing Then
    Cancel = True
    With ActiveCell.Font
        .Name = "Wingdings 2"
        If ActiveCell.Value = "R" Then
          ActiveCell.Value = "£"
        ElseIf ActiveCell.Value = "" Or ActiveCell.Value = "£" Then
          ActiveCell.Value = "R"
        End If
    End With
  End If
End If
End Sub
0
mstecluque Messages postés 73 Date d'inscription   Statut Membre Dernière intervention  
 
Si qqun veut rire, c'est pcq je testais 8 cases plus à droite alors que je voulais tester 8 cases plus à gauche.
0

Discussions similaires

Transformer un chiffre en lettres dans excel sans macro
vincentphilippos -
tontong -

6 réponses
recup couleur de cellule sans macro
magouero -
JvDo -

7 réponses
EXCEL transformer chiffres en lettre -facture
roland -
JBB -

26 réponses
Arrêt d'exécution d'un code vba
amiro2017 -
amiro2017 -

6 réponses
convertir des chiffres en lettres avec une unique formule
FOUAD_9000 -
Mike-31 -

34 réponses