Discussion :

[Invité]

Bonjour,

Grâce à Mercatog, qui a intervenu à 2 reprises pour me donner un sacré coup de main, que je salue et remercie.

Donc en cochant une checkbox son caption est inscrit sur la feuille BD (selon des coordonnées répertoriées en feuille App) et en décochant le caption est effacer.
Mercatog a utilisé un module de classe, que je ne maitrise pas du tout. J'ai compris qu'il gère la multitude des checkboxs présentent sur la feuille "m_a" et que le code réagit à l'action de cocher/décocher.

Maintenant, je voudrais utiliser un bouton sur la feuille BD pour faire une boucle sur les chekboxs, si la checkbox est cochée inscrire comme auparavant le caption.
Par contre, si la checkbox est décochée l'effacer et l'inscrire en colonne L (soit .offset(i,5), mais comme en colonne L, il peut y avoir une donnée, on concatène cette donnée et le caption. exemple, en L4 il y a "RAS" , le caption étant "TT08", il est effacer de G4 et concaténer en L4, résultat:"RAS" "TT08".

je bute sur 2 difficulté, la première c'est le module de classe existant. Je ne sais pas l'utiliser et la seconde, je tourne en rond pour compter ces satanées checkboxs (est-ce des shapes ou des objects). Tous mes essais ont été vains.
voici les codes actuels du fichier qui fonctionne bien
module

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Option Explicit
 
Sub TestOnOff(ByVal App As String, ByVal Etat As Boolean)
Dim LastLigD As Long, LastLigB As Long, i As Long, j As Long
Dim Tb, Td
 
With Worksheets("APP")
    LastLigD = .Cells(.Rows.Count, "A").End(xlUp).Row
    Td = .Range("A2:F" & LastLigD)
End With
 
With Worksheets("BD")
    LastLigB = .Cells(.Rows.Count, "B").End(xlUp).Row
    Tb = .Range("B2:G" & LastLigB)
    For i = 1 To LastLigD - 1                         'boucle sur Td (App)
        For j = 1 To LastLigB - 1                     'boucle sur Tb (BD)
            If Not Etat Then
                If Tb(j, 6) = App Then Tb(j, 6) = ""
            Else
                If Tb(j, 6) = "" Then
                    If Td(i, 6) = App And Td(i, 1) & "|" & Td(i, 2) & "|" & Td(i, 3) & "|" & Int(Td(i, 4)) = _
                       Tb(j, 1) & "|" & Tb(j, 2) & "|" & Tb(j, 3) & "|" & Int(Tb(j, 4)) Then Tb(j, 6) = App
                End If
            End If
        Next j
    Next i
    .Range("B2:G" & LastLigB) = Tb
End With
End Sub

Classe

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Option Explicit
Public WithEvents Chk As MsForms.CheckBox
 
Private Sub Chk_Click()
 
If ChkExists(Chk.Caption) Then
    TestOnOff Chk.Caption, Chk.Value
Else
    If Chk.Value Then
        Chk.Value = False
        MsgBox Chk.Caption & " inéxistant dans la BD!"
    End If
End If
End Sub
 
Private Function ChkExists(ByVal NomApp As String) As Boolean
ChkExists = Not Worksheets("APP").Range("F:F").Find(NomApp, LookIn:=xlValues, lookat:=xlWhole) Is Nothing
End Function

code feuille "m_a"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Option Explicit
 
Dim CC() As Classe1
 
Private Sub Worksheet_Activate()
Dim CB As OLEObject
Dim i As Integer
 
For Each CB In Feuil1.OLEObjects
    If Left(CB.Name, 3) = "Chk" Then
        i = i + 1
        ReDim Preserve CC(1 To i)
        Set CC(i) = New Classe1
        Set CC(i).Chk = CB.Object
    End If
Next CB
End Sub
 
Private Sub Cb_RetourBD_Click()
Sheets("BD").Activate
End Sub

Sur la feuille "m_a", il y a 45 checkboxs et 1 commandButton. En vous remerciant par avance

[mercatog]

Bonjour cathodiqe (ça rime avec méthodique)

Bon voila le résultat qu'on on ne demande pas à comprendre et à ré-utiliser un code car comme tu le constate et je l'avais déjà mentionné il ne suffit pas de tester un code qu'on partage avec toi mais c'est une piste pour pouvoir étudier en profondeur le langage.

En fin de compte, en te proposant un code clé en main, je ne t'aide pas vraiment. Alors retrousse tes manches et au boulot

Désormais, le forum peut te guider ou de te faire ton travail, ça dépend.

Voilà, je vais répondre à une question que tu n'as pas posé.

Contexte:
On a une multitudes de CheckBox à gérer.
1. Soit on les gère un par un
Inconvénients:
On répète la même chose pour tous les CheckBox (100 Checkbox=10 codes à écrire)
Si on ajoute un CheckBox, on est obligé d'écrire son code

2. Soit on utilise les modules de classe
Avantages:
On écrit le code une seule fois
Même si on ajoute un nombre quelconque de Checkbox, on ne touche pas aux codes

Maintenant revenons à notre sujet

Tu as vu comment on définit le code de la classe (qu'on va affecter à tous les Checkbox)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Option Explicit
 
Public WithEvents Chk As MsForms.CheckBox
 
Private Sub Chk_Click()
 
If ChkExists(Chk.Caption) Then
    TestOnOff Chk.Caption, Chk.Value
Else
    If Chk.Value Then
        Chk.Value = False
        MsgBox Chk.Caption & " inéxistant dans la BD!"
    End If
End If
End Sub
 
Private Function ChkExists(ByVal NomApp As String) As Boolean
 
ChkExists = Not Worksheets("APP").Range("F:F").Find(NomApp, LookIn:=xlValues, lookat:=xlWhole) Is Nothing
End Function

ça c'est notre code qu'on veut affecter à nos Checkbox (qu'elles soient 3 ou 2000) et jusqu'à présent, rien n'indique aux checkbox que la classe précédente leur est destinée.

Donc, on doit "lier" ces Checkbox à note classe (par différentes méthodes): Pour ton cas, on a utilisé l'évènement Activate de la feuille m_a. C'est à dire, dès qu'on active la feuille m_a, l'instanciation des Checkbox s'opère.

Pour cela on a crée une variable tableau CC de type Classe1 dans laquelle on met tous les éléments Oleobjects commençant par "Chk"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Private Sub Worksheet_Activate()
Dim CB As OLEObject
Dim i As Integer
 
For Each CB In Feuil1.OLEObjects
    If Left(CB.Name, 3) = "Chk" Then
        i = i + 1
        ReDim Preserve CC(1 To i)
        Set CC(i) = New Classe1
        Set CC(i).Chk = CB.Object
    End If
Next CB
End Sub

La liaison est dès lors faite entre les Checkbox et le code de la Classe et de cette façon, les n CheckBox vont se comporter comme si on leur a attribué implicitement le(s) code(s) de la Classe.


Tu vois bien que le nombre des Checkbox est égal au nombre d'éléments contenus dans le tableau CC

Tu vois bien que si on parcourt les éléments du tableau CC, on retrouve les objets Chekbox

Et enfin, tu vois bien que si on fait ce test, on aura les informations nécessaires

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Dim i As Integer
 
For i = 1 To UBound(CC)
    MsgBox CC(i).Chk.Name & "  " & CC(i).Chk.Caption & "  " & CC(i).Chk.Value
Next i

PS. La variable CC a été déclarée en début du module de la feuille m_a. C'est dire, elle ne sera reconnue que dans les codes de cette feuille.
Pour l'utiliser dans d'autres modules, il suffit de la déclarer dans un module standard

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Public CC() As Classe1

PS2. J'ai fait une explication littéraire et sommaire.

[Invité]

Bonjour Mercatog,

cathodique (ça rime avec méthodique)

ça vient de "Protection Cathodique" mon métier d'antan pour lequel il faut en effet être méthodique.

Je m'aperçois que tu n'es pas du tout content de moi. je reconnais que les modules de classe et les fonctions me déroutent.

Et je crois que je n'aurai pas dû faire référence à la précédente discussion, ni éditer le code.
Même si je suis faible en vba, j'avais bien compris que la classe était instanciée dans l'événement activate de la feuille m_a (enfin, moi j'aurai dit déclenché).

Ne pense surtout pas que je cherche du tout cuit comme on dit. Je ne réponds que maintenant à ton post, pourquoi? Simplement, je cherchais sur le forum une réponse.

Ce que je cherche, c'est de faire une boucle (For/Next) sur les checkboxs et exécuter un code suivant leur état. Je bute sur la déclaration des checkboxs

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
dim Chk As MsForms.CheckBox
For Each Chk In Worksheets("m_a")
'code
next

C'est ainsi que tu as déclaré les checkboxs, j'ai fait comme toi mais ça plante sur la For (erreur d'execution 438, Propriété ou Méthode non gérée par cet objet)

j'ai bien trouvé des exemples certains utilisent shapes, d'autres MsForms.CheckBox, d'autres Object et d'autres OLEObject. Et chez moi ça ne fonctionne pas du tout.

Cette macro je la déclencherai avec un bouton que j'ai mis sur la feuille BD (donc à mon avis, la classe ne sera pas sollicitée, étant donné qu'elle dépend de la feuille "m_a".

Je te remercie de m'avoir tout réexpliqué et je m'excuse pour le quiproquo, je t'ai induit en erreur.

je constate que ça a fait l'effet inverse. Je voulais juste expliquer ce qui a été déjà fait.

Avec mes remerciements.

Cordialement,

[mercatog]

Enlève la ligne de code du module de la feuille m_a

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Dim CC() As Classe1

Remplace dans le module standard TestOnOff par ceci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Option Explicit
 
Public CC() As Classe1
 
Sub TestOnOff(ByVal App As String, ByVal Etat As Boolean, Optional OCK As Boolean)
Dim LastLigD As Long, LastLigB As Long, i As Long, j As Long
Dim Tb, Td
 
With Worksheets("APP")
    LastLigD = .Cells(.Rows.Count, "A").End(xlUp).Row
    Td = .Range("A2:F" & LastLigD)
End With
 
With Worksheets("BD")
    LastLigB = .Cells(.Rows.Count, "B").End(xlUp).Row
    Tb = .Range("B2:L" & LastLigB)
    For i = 1 To LastLigD - 1                         'boucle sur Td (App)
        For j = 1 To LastLigB - 1                     'boucle sur Tb (BD)
            If Not Etat Then
                If Tb(j, 6) = App Then
                    Tb(j, 6) = ""
                    If OCK Then Tb(j, 11) = Trim(Tb(j, 11) & " " & App)
                End If
            Else
                If Tb(j, 6) = "" Then
                    If Td(i, 6) = App And Td(i, 1) & "|" & Td(i, 2) & "|" & Td(i, 3) & "|" & Int(Td(i, 4)) = _
                       Tb(j, 1) & "|" & Tb(j, 2) & "|" & Tb(j, 3) & "|" & Int(Tb(j, 4)) Then Tb(j, 6) = App
                End If
            End If
        Next j
    Next i
    .Range("B2:L" & LastLigB) = Tb
End With
End Sub

Après, il suffit de faire (ce que j'essaie d'expliquer)! Tu as un tableau CC contenant tes Checkbox alors que tu essaies de regarder ailleurs. Mais bon

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub MAJ()
Dim i As Integer
Dim App As String
Dim Etat As Boolean
 
Application.ScreenUpdating = False
Worksheets("m_a").Activate
For i = 1 To UBound(CC)
    App = CC(i).Chk.Caption
    Etat = CC(i).Chk.Value
    TestOnOff App, Etat, True
Next i
Worksheets("BD").Activate
End Sub

[Invité]

Bonjour Mercatog,

Ta réponse a été très rapide. Je ne veux pas modifier ton précédent code avec le module de classe, je le conserve dans mon fichier.

Je voudrai rajouter une macro pour un besoin différent. Dans la FAQ, je suis enfin parvenu à trouver quelque chose.

Voici ce que j'ai fait mais un problème subsiste pour l'effacement et la concaténation.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
Option Explicit
 
Sub MàJ_BD()
    Dim LastLigD As Long, LastLigB As Long, i As Long, j As Long, k As Byte
    Dim Tb, Td
    Dim Chk As OLEObject    'MsForms.CheckBox
    Dim f As Worksheet, Vchk As Boolean, Nchk As String
    Set f = Worksheets("m_a")
 
    Application.ScreenUpdating = False
 
    With Worksheets("APP")
        LastLigD = .Cells(.Rows.Count, "A").End(xlUp).Row
        Td = .Range("A2:F" & LastLigD)
    End With
 
    With Worksheets("BD")
        For k = 1 To 45
            Vchk = f.OLEObjects("Chk" & k).Object.Value
            Nchk = f.OLEObjects("Chk" & k).Object.Caption
 
            LastLigB = .Cells(.Rows.Count, "B").End(xlUp).Row
            Tb = .Range("B2:L" & LastLigB)
            For i = 1 To LastLigD - 1                         'boucle sur Td (App)
                For j = 1 To LastLigB - 1                     'boucle sur Tb (BD)
                    If Vchk = False Then
                      '  If Tb(j, 6) = Nchk Then Tb(j, 6) = ""
                      '  If Td(i, 6) = Nchk And Td(i, 1) & "|" & Td(i, 2) & "|" & Td(i, 3) & "|" & Int(Td(i, 4)) = _
                           Tb(j, 1) & "|" & Tb(j, 2) & "|" & Tb(j, 3) & "|" & Int(Tb(j, 4)) Then Tb(j, 12) = Tb(j, 12) & Nchk
                    Else
                        If Tb(j, 6) = "" Then
                            If Td(i, 6) = Nchk And Td(i, 1) & "|" & Td(i, 2) & "|" & Td(i, 3) & "|" & Int(Td(i, 4)) = _
                               Tb(j, 1) & "|" & Tb(j, 2) & "|" & Tb(j, 3) & "|" & Int(Tb(j, 4)) Then Tb(j, 6) = Nchk
                        End If
                    End If
                Next j
            Next i
        Next k
 
        .Range("B2:G" & LastLigB) = Tb
    End With
End Sub

Au fait merci pour l'utilitaire, il est vraiment super.

Merci, je vois tes codes pour essayer de résoudre mon problème.

Cordialement,

[mercatog]

Maintenant tu es entrain de t'enterrer

Pourquoi recréer la roue alors qu'avec une petite modification du code existant, le nouveau résultat souhaité est exact?

Dans dans mon dernier code, j'ai tout laissé tel qu'auparavant avec une petite modification de la sub TestOnOff, du changement de du module de déclaration de la variable CC et l'ajout d'une petite procédure de mise à jour

En principe, une code sobre et commenté vaut mieux que des redondances inutiles.

A toi de choisir

[Invité]

Re,

Je viens de consulter tes codes et j'ai bien constaté les modifications que tu as faites.

Après, il suffit de faire (ce que j'essaie d'expliquer)! Tu as un tableau CC contenant tes Checkbox alors que tu essaies de regarder ailleurs. Mais bon

Je ne suis pas très à l'aise en VBA. Ce qui est évident pour toi ne l'est pas nécessairement pour moi. Je n'ai pas tes compétences, il ne faut donc pas trop m'en vouloir.

Je n'ai pas encore testé tes derniers codes. Mais voici quelques précisions, je n'ai pas voulu refaire un autre fichier pour cette discussion pour les raisons ci-dessous.

En fait sur mon fichier, J'ai 2 feuilles BD (BD1 et BD2) identiques; BD2 me sert pour effectuer des calculs pour cela c'est moi qui coche les cases (ce sont des références utilisées dans les formules; et BD1 est en quelque sorte un formulaire à imprimer.

Donc je voudrais conserver ton précédent code tel quel et ajouter une autre macro, c'est à dire avoir 2 procédures indépendantes.

En te remerciant.

Cordialement,