Boucle sur checkbox (module de classe)

Version imprimable

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:

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:

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:

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

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:

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:

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:

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:

Public CC() As Classe1

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

26/04/2014, 17h56
Invité
Bonjour Mercatog,

Citation:

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:

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,

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

Code:

Dim CC() As Classe1

Remplace dans le module standard TestOnOff par ceci

Code:

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:

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

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:

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,

26/04/2014, 19h27
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
26/04/2014, 19h48
Invité

Re,

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

Citation:

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,

Voilà, j'ai revu ton fichier et les codes qu'il contient vu les dernières nouveautés

1. Module ThisWorkbook

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
Option Explicit
 
'---------------------------------------------------------------------------------------
' Procedure : Workbook_Open
' Author    : VAL
' Date      : 26/04/2014
' Purpose   : A l'ouverture du classeur, CC est remplie des Checkbox
'---------------------------------------------------------------------------------------
'
Private Sub Workbook_Open()
 
Initialize
End Sub

2. Module de classe Classe1

Code:

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 WithEvents Chk As MsForms.CheckBox
 
'---------------------------------------------------------------------------------------
' Procedure : Chk_Click
' Author    : VAL
' Date      : 26/04/2014
' Purpose   : Procédure qui englobe le code sur Click des Chekbox
'---------------------------------------------------------------------------------------
'
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
 
'---------------------------------------------------------------------------------------
' Procedure : ChkExists
' Author    : VAL
' Date      : 26/04/2014
' Purpose   : Fonction booléenne qui est vrai si l'appareil NOMAPP existe dans la feuille APP
'---------------------------------------------------------------------------------------
'
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

3. Module standard

Code:

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
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
Option Explicit
 
'---------------------------------------------------------------------------------------
'Declaration de la variable CC qui va contenir tous les Chekbox
'---------------------------------------------------------------------------------------
'
Dim CC() As Classe1
 
'---------------------------------------------------------------------------------------
' Procedure : Initialize
' Author    : VAL
' Date      : 26/04/2014
' Purpose   : Permet de boucler les Checkbox et de les instancier à l'aide du tableau CC
'             de type Classe1
'---------------------------------------------------------------------------------------
'
Sub Initialize()
Dim CB As OLEObject
Dim i As Integer
 
For Each CB In Worksheets("m_a").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
 
'---------------------------------------------------------------------------------------
' Procedure : TestOnOff
' Author    : VAL
' Date      : 26/04/2014
' Purpose   : Procédure qui permet d'inscrire ou d'effacerle nom de l'appareil APP
'             en fonction de sa valeur ETAT
'             Le paramètre optionnel OCK (si à True) permet d'ajouter l'appareil APP
'             à effacer de la colonne G dans la colonne L
'             Si OCK est False ou omis, l'effacement de l'apperil ne s'accompagne
'             pas des des inscriptions en colonne L
'---------------------------------------------------------------------------------------
'
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
                        If InStr(Tb(j, 11), App) = 0 Then Tb(j, 11) = Trim(Tb(j, 11) & " " & App)
                    End If
                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
 
'---------------------------------------------------------------------------------------
' Procedure : MAJ
' Author    : VAL
' Date      : 26/04/2014
' Purpose   : Procédure qui boucle sur tous les éléments du tableau des Checkbox CC
'             et d'inscrire ou d'effacer l'appareil correspondant avec inscription
'             de l'apperil effacé en colonne L (cf OCK=True)
'---------------------------------------------------------------------------------------
'
Sub MAJ()
Dim i As Integer
Dim App As String
Dim Etat As Boolean
 
Application.ScreenUpdating = False
Initialize
For i = 1 To UBound(CC)
    App = CC(i).Chk.Caption
    Etat = CC(i).Chk.Value
    TestOnOff App, Etat, True
Next i
End Sub

4. Module de la feuille m_a

Code:

1
2
3
4
5
6
7
8
9
10
11
Option Explicit
 
Private Sub Worksheet_Activate()
 
Initialize
End Sub
 
Private Sub Cb_RetourBD_Click()
 
Worksheets("BD").Activate
End Sub

5. Module de la feuille bd

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
Option Explicit
 
Private Sub Cb_màj_Click()
 
MAJ
MsgBox "Mise à jour terminée"
End Sub
 
Private Sub Cb_Reset_Click()
 
Application.ScreenUpdating = False
Worksheets("bd_vide").UsedRange.Copy Worksheets("bd").Range("A1")
End Sub

6. Ton fichier

26/04/2014, 22h22
Invité

Bonsoir Mercatog,

Je te remercie infiniment pour tout le travail que tu as accompli. Mais je n'obtiens pas le résultat escompté. J'aurai dû insérer la 2ème feuille sur mon fichier, car sur celle-ci les appareils ne figurent sont nécessairement sur la feuille.

c'est pour cela que je voulais 2 procédures indépendantes. Ton premier code qui fonctionne très bien, quand je coche et décoche les checkboxs sur la feuille m_a, les noms s’inscrivent ou s'effacent à leurs endroits exacts sur la feuille BD.

J'ai rajouté la feuille BD1 et sur celle-ci, je voudrais reporter suivant l’état des chekboxs: si true comme précédent code en colonne 6 et si c'est false le concaténer avec ce qu'il y a en colonne 11.

Je te le dis franchement, tu es très compétent et moi je n'arrive pas à suivre.

Citation:

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

Je ne doute pas un seul instant que tu aies raison, hélas mes connaissances sont limitées. J'ai pu le constater les modules de classe simplifie avantageusement les codes mais il faudrait que je les comprenne pour en tirer profit et surtout apprendre quand ils sont nécessaire et les reproduire. Sinon, ça sera juste un code dans un fichier que je ne réutiliserai peut-être plus.

Je joins un autre fichier avec la 2ème feuille, j'ai mis en colonne "I" le résultat attendu. Les codes seront insérés dans mon fichier original, j'ai fait ce fichier que illustrer mon problème.

Je te souhaite une très bonne soirée. Merci.

Cordialement,

Le même code TestOnOff agira sur 2 feuilles. On va donc ajouter comme paramètre de la sub la feuille à laquelle se rapporte le code

Changements effectués seulement ici
Module standard

Code:

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
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
Option Explicit
 
'---------------------------------------------------------------------------------------
'Declaration de la variable CC qui va contenir tous les Chekbox
'---------------------------------------------------------------------------------------
'
Dim CC() As Classe1
 
'---------------------------------------------------------------------------------------
' Procedure : Initialize
' Author    : VAL
' Date      : 26/04/2014
' Purpose   : Permet de boucler les Checkbox et de les instancier à l'aide du tableau CC
'             de type Classe1
'---------------------------------------------------------------------------------------
'
Sub Initialize()
Dim CB As OLEObject
Dim i As Integer
 
For Each CB In Worksheets("m_a").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
 
'---------------------------------------------------------------------------------------
' Procedure : TestOnOff
' Author    : VAL
' Date      : 26/04/2014
' Purpose   : Procédure qui permet d'inscrire ou d'effacerle nom de l'appareil APP
'             en fonction de sa valeur ETAT
'             Le paramètre optionnel OCK (si à True) permet d'ajouter l'appareil APP
'             à effacer de la colonne G dans la colonne L
'             Si OCK est False ou omis, l'effacement de l'apperil ne s'accompagne
'             pas des des inscriptions en colonne L
'---------------------------------------------------------------------------------------
'
Sub TestOnOff(ByVal Ws As Worksheet, 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 Ws
    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
                        If InStr(Tb(j, 11), App) = 0 Then Tb(j, 11) = Trim(Tb(j, 11) & " " & App)
                    End If
                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
 
'---------------------------------------------------------------------------------------
' Procedure : MAJ
' Author    : VAL
' Date      : 26/04/2014
' Purpose   : Procédure qui boucle sur tous les éléments du tableau des Checkbox CC
'             et d'inscrire ou d'effacer l'appareil correspondant avec inscription
'             de l'appareil effacé en colonne L (cf OCK=True)
'---------------------------------------------------------------------------------------
'
Sub MAJ()
Dim i As Integer
Dim App As String
Dim Etat As Boolean
 
Application.ScreenUpdating = False
Initialize
For i = 1 To UBound(CC)
    App = CC(i).Chk.Caption
    Etat = CC(i).Chk.Value
    TestOnOff Worksheets("BD1"), App, Etat, True
Next i
End Sub

Module de classe

Code:

1
2
3
4
5
6
7
8
9
10
11
Private Sub Chk_Click()
 
If ChkExists(Chk.Caption) Then
    TestOnOff Worksheets("BD"), 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

C'est tout

Quand on clique sur un Checkbox, les changements s’opèrent seulement sur BD
Quand on clique sur le bouton de mise à jour, les changements s’opèrent sur BD1

Bonsoir,

J'ai une erreur de compilation, je récapitule les codes présents dans le fichier
Module standard

Code:

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
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
Option Explicit
 
'---------------------------------------------------------------------------------------
'Declaration de la variable CC qui va contenir tous les Chekbox
'---------------------------------------------------------------------------------------
'
Dim CC() As Classe1
 
'---------------------------------------------------------------------------------------
' Procedure : Initialize
' Author    : VAL
' Date      : 26/04/2014
' Purpose   : Permet de boucler les Checkbox et de les instancier à l'aide du tableau CC
'             de type Classe1
'---------------------------------------------------------------------------------------
'
Sub Initialize()
Dim CB As OLEObject
Dim i As Integer
 
For Each CB In Worksheets("m_a").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
 
'---------------------------------------------------------------------------------------
' Procedure : TestOnOff
' Author    : VAL
' Date      : 26/04/2014
' Purpose   : Procédure qui permet d'inscrire ou d'effacerle nom de l'appareil APP
'             en fonction de sa valeur ETAT
'             Le paramètre optionnel OCK (si à True) permet d'ajouter l'appareil APP
'             à effacer de la colonne G dans la colonne L
'             Si OCK est False ou omis, l'effacement de l'apperil ne s'accompagne
'             pas des des inscriptions en colonne L
'---------------------------------------------------------------------------------------
'
Sub TestOnOff(ByVal Ws As Worksheet, 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 Ws
    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
                        If InStr(Tb(j, 11), App) = 0 Then Tb(j, 11) = Trim(Tb(j, 11) & " " & App)
                    End If
                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
 
'---------------------------------------------------------------------------------------
' Procedure : MAJ
' Author    : VAL
' Date      : 26/04/2014
' Purpose   : Procédure qui boucle sur tous les éléments du tableau des Checkbox CC
'             et d'inscrire ou d'effacer l'appareil correspondant avec inscription
'             de l'appareil effacé en colonne L (cf OCK=True)
'---------------------------------------------------------------------------------------
'
Sub MAJ()
Dim i As Integer
Dim App As String
Dim Etat As Boolean
 
Application.ScreenUpdating = False
Initialize
For i = 1 To UBound(CC)
    App = CC(i).Chk.Caption
    Etat = CC(i).Chk.Value
    TestOnOff Worksheets("BD1"), App, Etat, True
Next i
End Sub

Dans TihsWorkBook

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
Option Explicit
 
'---------------------------------------------------------------------------------------
' Procedure : Workbook_Open
' Author    : VAL
' Date      : 26/04/2014
' Purpose   : A l'ouverture du classeur, CC est remplie des Checkbox
'---------------------------------------------------------------------------------------
'
Private Sub Workbook_Open()
 
Initialize
End Sub

Code feuille BD

Code:

1
2
3
4
5
6
7
8
Option Explicit
 
Private Sub Cb_màj_Click()
 
Application.ScreenUpdating = False
MAJ
MsgBox "Mise à jour terminée"
End Sub

Code feuille m_a

Code:

1
2
3
4
5
6
Option Explicit
 
Private Sub Worksheet_Activate()
 
Initialize
End Sub

Code feuille BD1

Code:

1
2
3
4
5
6
7
8
Option Explicit
 
Private Sub Cb_màj_Click()
 
Application.ScreenUpdating = False
MAJ
MsgBox "Mise à jour terminée"
End Sub

Module de classe

Code:

1
2
3
4
5
6
7
8
9
10
11
12
Option Explicit
Private Sub Chk_Click()
 
If ChkExists(Chk.Caption) Then
    TestOnOff Worksheets("BD"), 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

voici l'erreur en image, le cocher/decocher ne fonctionne plus.

Je te remercie beaucoup pour tout.

Bonne soirée.

Cordialement,

26/04/2014, 23h48
mercatog

Assure toi, j'ai testé et ça fonctionne

Comme je vois que tu as 2 classeurs ouverts remplace partout

Code:

Worksheets(xxx)

par

Code:

ThisWorkbook.Worksheets(xxx)

Fichier
27/04/2014, 00h05
Invité

En effet, j'avais 2 fichiers ouverts c'est peut-être dû à ça.

j'ai téléchargé le fichier, le cocher/décocher fonctionne bien. Mais pour la Deuxième partie, je me suis comme d'habitude mal fait comprendre.

Je voudrais que tout les appareils Hors-service (case décochée) se mettent en colonne11 et s'il y a une donnée en colonne11, concaténer cette donnée et appareil.

Et ceux qui sont en service se mettent en colonne 6, comme pour les cases à cocher.

Actuellement le code met le nom de l'appareil s'il y a quelque chose en colonne11 et ne met rien si la colonne est vide.

Merci beaucoup.

Cordialement,
27/04/2014, 00h15
mercatog

Est tu certain

Parce que sur BD1, les noms se mettent en colonne L quelque soit ce qu'il y a en L (vide ou quelque chose)

Bon, Si en L j'ai TT108 et que je coche TT108 et ensuite je décoche et je met à jour BD1, en L je n'aurai pas TT108 TT108 (j'aurai seulement TT108 une seule fois)

Ou bien quelque chose m'échappe.
27/04/2014, 00h42
Invité

Citation:

Bon, Si en L j'ai TT108 et que je coche TT108 et ensuite je décoche et je met à jour BD1, en L je n'aurai pas TT108 TT108 (j'aurai seulement TT108 une seule fois)

sur la base de ce que tu me demandes ci-dessus:
- si en L tu as TT108, ça veut dire que TT108 était décoché
- si tu coches TT108, et qu'on mette à jour TT108 se mettra en G et s'effacera de L
Maintenant si en L il y a une donnée différente de TT108 ex: RAS
-si on décoche TT108, en L nous aurons "RAS TT108"
-si on coche TT108, TT108 se mettra en G et en L ne restera que RAS

Donc les cochées en G et les décochées en L.

Merci beaucoup

Citation:

Envoyé par cathodique

- si tu coches TT108, et qu'on mette à jour TT108 se mettra en G et s'effacera de L
Maintenant si en L il y a une donnée différente de TT108 ex: RAS
-si on décoche TT108, en L nous aurons "RAS TT108"
-si on coche TT108, TT108 se mettra en G et en L ne restera que RAS
Merci beaucoup

Je devais devinais ça car c'est la première fois que tu en parle

Remplace TestOnOff par celle-ci

Code:

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
'---------------------------------------------------------------------------------------
' Purpose   : Procédure qui permet d'inscrire ou d'effacerle nom de l'appareil APP
'             en fonction de sa valeur ETAT
'             Le paramètre optionnel OCK (si à True) permet d'ajouter l'appareil APP
'             à effacer de la colonne G dans la colonne L
'             Si OCK est False ou omis, l'effacement de l'apperil ne s'accompagne
'             pas des des inscriptions en colonne L
'---------------------------------------------------------------------------------------
'
Sub TestOnOff(ByVal Ws As Worksheet, 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 ThisWorkbook.Worksheets("APP")
    LastLigD = .Cells(.Rows.Count, "A").End(xlUp).Row
    Td = .Range("A2:F" & LastLigD)
End With
 
With Ws
    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
                        If OCK Then Tb(j, 11) = Trim(Replace(Tb(j, 11), App, ""))
                    End If
                End If
            End If
        Next j
    Next i
    .Range("B2:L" & LastLigB) = Tb
End With
End Sub

27/04/2014, 00h59
Invité

Voici ce que j'ai remarqué:

Si je coche par exemple TT08 et que je mette à jour TT08 se met en G, par contre toutes les checkboxs non cochées ne se mettent pas en L.

Maintenant, quand je décoche TT08, elle s'efface de G et se concatène en L avec la donnée qui était en L. Donc le code réagit une action sur la checkbox.
27/04/2014, 01h08
mercatog

J'ai tout décoché OK
J'ai tout recoché OK
J'ai décoché certains et d'autre non (pour moi OK)

Sinon, crée moi un nouveau exemple avec les résultats escomptés
27/04/2014, 01h29
Invité

Chez moi ce n'est pas OK, tu sais je suis limité mais je pense que le problème vienne de l'évenement click.

imagine que tu ouvres le fichier et que tu veuilles mettre à jour la feuille BD, sans toucher l'état des checkboxs.

car chez moi, le code fonctionne (càd mets quelque chose en L) si et seulement je manipule une checkbox (cocher puis decocher).

ce soir, je suis crevé. je te ferai un topo demain.

Merci pour tout.

Bonne soirée.

J'ai un peu fouiné pour pouvoir avoir une idée. Je crois que je suis arrivé à un résultat.

Pendant ce temps là, je me suis aperçu qu'il y a des cas où on est en présence de 2 appareils au même endroit. Exemple TT23 et TE15 ou TT14 et TT18 ou encore TT05 et TT06.

Je suis adapté le code du module standard en sorte.

La mise à jour de BD1 est un peu lente (7-8s)

Le reste reste inachangé

Module standard

Code:

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
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
Option Explicit
 
Dim CC() As Classe1
 
'---------------------------------------------------------------------------------------
' Purpose   : Permet de boucler les Checkbox et de les instancier à l'aide du tableau CC
'             de type Classe1
'---------------------------------------------------------------------------------------
'
Sub Initialize()
Dim CB As OLEObject
Dim i As Integer
 
For Each CB In ThisWorkbook.Worksheets("m_a").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
 
'---------------------------------------------------------------------------------------
' Purpose   : Procédure qui permet d'inscrire ou d'effacerle nom de l'appareil APP
'             en fonction de sa valeur ETAT
'             Le paramètre optionnel OCK (si à True) permet d'ajouter l'appareil APP
'             à effacer de la colonne G dans la colonne L
'             Si OCK est False ou omis, l'effacement de l'apperil ne s'accompagne
'             pas des des inscriptions en colonne L
'---------------------------------------------------------------------------------------
'
 
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 Ws As Worksheet
Dim Tb, Td
 
With ThisWorkbook.Worksheets("APP")
    LastLigD = .Cells(.Rows.Count, "A").End(xlUp).Row
    Td = .Range("A2:F" & LastLigD)
End With
 
If OCK Then
    Set Ws = ThisWorkbook.Worksheets("BD1")
Else
    Set Ws = ThisWorkbook.Worksheets("BD")
End If
 
With Ws
    LastLigB = .Cells(.Rows.Count, "B").End(xlUp).Row
    Tb = .Range("B2:L" & LastLigB)
    For i = 1 To LastLigD - 1
        For j = 1 To LastLigB - 1
 
            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
 
                If Etat Then
                    If InStr(Tb(j, 6), App) = 0 Then Tb(j, 6) = Trim(Tb(j, 6) & " " & App)
                    If OCK Then Tb(j, 11) = Trim(Replace(Tb(j, 11), App, ""))
                Else
                    Tb(j, 6) = Trim(Replace(Tb(j, 6), App, ""))
                    If OCK Then
                        If InStr(Tb(j, 11), App) = 0 Then Tb(j, 11) = Trim(Tb(j, 11) & " " & App)
                    End If
                End If
 
            End If
        Next j
    Next i
    .Range("B2:L" & LastLigB) = Tb
End With
Set Ws = Nothing
End Sub
 
Sub MAJ()
Dim i As Integer
Dim App As String
Dim Etat As Boolean
 
Application.ScreenUpdating = False
Initialize
For i = 1 To UBound(CC)
    App = CC(i).Chk.Caption
    Etat = CC(i).Chk.Value
    TestOnOff App, Etat, True
Next i
End Sub

Fichier

27/04/2014, 08h44
Invité

Bonjour Mercatog,:ccool:

Je ne te remercierai jamais assez. En effet, la mise à jour de BD1 est lente (11-12s) chez moi. Elle est moins lente chez toi (7-8s).
Car j'ai un vieux tacot Acer encore sous XP et auquel j'ai dû rajouter de la Ram.

Avec tout ce que j'ai pu découvrir avec toi, les tableaux étaient beaucoup plus rapidement. Dans ce cas je constate que cela dépend aussi du traitement effectué.

C'est exactement le résultat que j'attendais, pour la célérité je n'ai pas le choix je vais faire avec.

Je ne vais t'en demander plus, encore merci et bon dimanche.

Cordialement,

Améliore la rapidité de la mise à jour en remplaçant la procédure TestOnOff par celle-ci. Moins jolie mais plus rapide

Code:

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
43
44
45
46
47
48
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 Ws As Worksheet
Dim Tb, Td
 
With ThisWorkbook.Worksheets("APP")
    LastLigD = .Cells(.Rows.Count, "A").End(xlUp).Row
    Td = .Range("A2:F" & LastLigD)
End With
 
If OCK Then
    Set Ws = ThisWorkbook.Worksheets("BD1")
Else
    Set Ws = ThisWorkbook.Worksheets("BD")
End If
 
With Ws
    LastLigB = .Cells(.Rows.Count, "B").End(xlUp).Row
    Tb = .Range("B2:L" & LastLigB)
    For i = 1 To LastLigD - 1
        For j = 1 To LastLigB - 1
        If Td(i, 6) = App Then
            If Td(i, 1) = Tb(j, 1) Then
                If Td(i, 2) = Tb(j, 2) Then
                    If Td(i, 3) = Tb(j, 3) Then
                        If Int(Td(i, 4)) = Int(Tb(j, 4)) Then
 
                            If Etat Then
                                If InStr(Tb(j, 6), App) = 0 Then Tb(j, 6) = Trim(Tb(j, 6) & " " & App)
                                If OCK Then Tb(j, 11) = Trim(Replace(Tb(j, 11), App, ""))
                            Else
                                Tb(j, 6) = Trim(Replace(Tb(j, 6), App, ""))
                                If OCK Then
                                    If InStr(Tb(j, 11), App) = 0 Then Tb(j, 11) = Trim(Tb(j, 11) & " " & App)
                                End If
                            End If
 
                        End If
                    End If
                End If
            End If
        End If
        Next j
    Next i
    .Range("B2:L" & LastLigB) = Tb
End With
Set Ws = Nothing
End Sub

28/04/2014, 08h15
Invité

Bonjour Mercatog,

Tu m'épates de plus en plus au fil des discussions. Bravo, c'est très gentil de ta part. Non c'est trop gentil.

Citation:

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.

Vois-tu, j'ai passé toute la journée d'hier à essayer de comprendre ton code. J'ai consulté l'aide, personnellement je trouve que pour certaines choses les explications données le sont pour un public ayant un niveau avancé.

Sans être indiscret, ça fait combien de temps que tu pratiques le VBA? Est-ce que tu as suivi une formation ou es-tu autodidacte? Comme moi.
Encore moi, j'apprends à mon rythme, doucement le matin et pas trop vite le soir, ça m’essouffle. Là je plaisante.

Moi je trouve que ton dernier code est joli et efficace. "Joli", c'est de l'artifice, c'est le résultat qui compte. Et il est là, encore bravo. Je ne remercierai jamais assez.

Je te souhaite une très bonne semaine.

Cordialement,