Pb. OLEObjects + module de classe

Version imprimable

23/10/2012, 15h23
mécano41

1 pièce(s) jointe(s)

Pb. OLEObjects + module de classe

Bonjour à tous,

J'ai fait un petit bout de code pour répondre à un besoin précis et je me trouve piégé par un problème étrange...

J'ai tout expliqué dans le fichier.

Si quelqu'un peut m'aider....

Merci d'avance

Cordialement
23/10/2012, 16h05
fring

Bonjour,

Pour diverses raisons, notamment celles expliquées ICI, il est souhaitable d'expliquer (le plus clairement possible) la demande directement dans le message.

Salut,
tes checkbox se nomment mal

essaye

Code:

1
2
3
4
5
6
7
8
9
 
Sub AjouteCoche(CelCib As Range)
Dim t
Set t = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CheckBox.1", _
                                    Left:=CelCib.Offset(0, -1).Left + 2, Top:=CelCib.Offset(0, -1).Top + 2, _
                                    Width:=10, Height:=15)
t.Name = "Coche" & CelCib.Row
 
End Sub

23/10/2012, 17h06
mécano41

Merci pour vos réponses.

Pour fring : j'y veillerai mais je ne voyais pas comment expliquer cela sans le code complet puisque, a priori, je ne sais pas de quel endroit vient le problème...

Pour Oliv- : désolé mais malheureusement ta modif de code n'enlève pas mon problème. :cry:
Ce qui est bizarre c'est que l'ajout ou l'effacement agissent de la même manière et que le résultat soit différent. J'ai vraiment tout essayé ... sauf la bonne méthode! Ce qui me gêne c'est de ne pas pouvoir suivre tout en pas-à-pas...Là où je peux mettre des points d'arrêt ou des MsgBox, tout semble être correct.

Cordialement
23/10/2012, 19h15
Oliv-

Essaye en supprimant au préalable tous les checkbox
24/10/2012, 08h59
mécano41

Bonjour,

Je l'avais envisagé, mais non essayé car cela m'oblige à mettre en mémoire les caractéristiques et état des coches non effacées pour les restituer ensuite correctement.

Je pense avoir trouvé une solution plus simple (reste à savoir si elle conviendra) : créer les coches sur toutes les lignes de la plage utile et les rendre invisibles ou visibles au lieu de les effacer ou de les remettre...

Je laisse néanmoins le sujet ouvert car on n'a pas trouvé le pourquoi du problème posé (pourquoi Pb. seulement après suppression).

Merci tout de même pour ta collaboration.

cordialement

PS: Quand tu supprime une case à cocher, elle n'est plus reconnue même si tu crée une autre portant le même non. Tu avais instancié l'objet et non le nom de l'objet.

Pour récupérer l'état des cases avant suppression à leur re création, il faudra quelque part mémoriser leur état. (par exemple en utilisant la colonne IV)

Module de Classe

Code:

1
2
3
4
5
6
7
8
9
' =============== Module de classe pour l'ensemble des boutons d'options
Private Sub GroupeCoches_Click()
Dim Lig As Long
 
' Remplacer ici la Msgbox par les actions à faire .....
MsgBox "Vous avez cliqué " & GroupeCoches.Name & " et sa position dans l'ordre de création est : " & GroupeCoches.Index
Lig = Replace(GroupeCoches.Name, "Coche", "")
ActiveSheet.Range("IV" & Lig) = GroupeCoches.Value
End Sub

Procédure Ajout

Code:

1
2
3
4
5
6
7
8
9
10
11
' --------------- Ajoute une coche sur la ligne, la redimensionne et la désigne par : Coche + N° de la ligne ----------------------------------------------------------------------------------------------
Sub AjouteCoche(ByVal CelCib As Range)
 
With ActiveSheet
    .OLEObjects.Add(ClassType:="Forms.CheckBox.1", Left:=CelCib.Offset(0, _
                                                                       -1).Left + 2, Top:=CelCib.Offset(0, -1).Top + 2, Width:=10, _
                                                                       Height:=15).Name = "Coche" & CelCib.Row
    Initialisation
    .OLEObjects("Coche" & CelCib.Row).Object.Value = .Range("IV" & CelCib.Row)
End With
End Sub

Salut,
Il semble que l'action add ou delete sur les oleobjects soit à l'origine de ce disfonctionnement dans le classeur que j'ai testé (et trituré dans tous les sens) j'ai apparemment le même pb après une création de checkbox.

Il semble que c'est initialisation qui ne fait pas son boulot correctement.

essaye

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
Sub Worksheet_Change(ByVal Cible As Range)
    Dim Vide As Boolean

    
    If Not Intersect(Cible, Range("PlageModif")) Is Nothing Then                                    ' Si la cellule modifiée est dans la plage prévue
        If Cible.Rows.Count <> 1 Then Exit Sub                                                            ' Si plusieurs cellules sélectionnées, on sort
        
        If Cible.Value = "" Then ' Si la cellule est vide (effacée ou rien rentré dedans)
        
        Application.OnTime Now + TimeValue("00:00:02"), "ModuleCasesAcocher.callInitialisation"


            Call EffaceCoche(Cible)                                                                                ' on efface la coche
        Else                                                                                                                   ' Si la cellule contient quelque chose
            Call VerifSiCoche(Cible, Vide)                                                                      ' on vérifie s'il y a une coche sur cette ligne
            If Vide = True Then                                                                                      ' Si la coche n'existe pas sur la ligne
                Call AjouteCoche(Cible)                                                                           ' on l'ajoute
            Else                                                                                                                   ' Si la coche existe,
                'Exit Sub                                                                                                ' on sort sans rien faire
            End If
        End If
        'MsgBox "before init"
        Call Initialisation
        'Cible.Offset(1, 0).Select                                                                                   ' On se positionne sur la ligne suivante
    End If
End Sub


' --------------- Relance l'Init après chaque modif -----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
dès que l'on clique sur une case cela se declanchait ??
Private Sub Worksheet_SelectionChange(ByVal Cible As Range)
    'Call Initialisation
End Sub

Code:

1
2
3
4
Sub callInitialisation()
'Stop
Call Initialisation
End Sub

Peut être faut 'il au préalable du delete supprimer le Cases() correspondant .

Tu peux aussi utiliser ActiveSheet.Shapes("Coche" & CelCib.Row) à la place de ton coda avec array..

Code:

1
2
3
4
5
6
7
8
9
10
11
Sub VerifSiCoche(CelCib As Range, CelVid As Boolean)
    Dim ThisCheckbox
    On Error Resume Next
    Set ThisCheckbox = ActiveSheet.Shapes("Coche" & CelCib.Row)                          ' Sélectionne la coche là où elle pourrait être
    If ThisCheckbox Is Nothing Then                                                                                    ' Si erreur, c'est qu'elle n'y est pas
        CelVid = True
    Else
        CelVid = False
    End If
    On Error GoTo 0                                                                                                   ' Remet la détection d'erreurs
End Sub

24/10/2012, 11h40
mécano41

Bonjour,

Merci pour ces renseignements.

Citation:

Envoyé par mercatog

PS: Quand tu supprimes une case à cocher, elle n'est plus reconnue même si tu crées une autre portant le même nom

Dans mon cas, le problème est que ce sont les cases à cocher restantes qui ne sont plus reconnues alors qu'une seule a été supprimée...mais c'est probablement moi qui ne comprends pas quelque chose...

Citation:

Tu avais instancié l'objet et non le nom de l'objet

J'ai des difficultés avec les OLEObjects... ; il va falloir que j'étudie cela d'un peu plus près. Reste à trouver un tutoriel car l'aide Microsoft...cela va pour se remémorer ce que l'on savait déjà...

Merci pour les autres infos mais je vais probablement passer à la solution que j'ai évoquée plus haut ; je voulais juste comprendre pourquoi l'autre fonctionne mal.

Cordialement
25/10/2012, 08h03
mécano41

Bonjour,

Citation:

Envoyé par Oliv-

Il semble que l'action add ou delete sur les oleobjects soit à l'origine de ce disfonctionnement dans le classeur que j'ai testé (et trituré dans tous les sens) j'ai apparemment le même pb après une création de checkbox.

Tu ne devrais pas avoir de problème après une création. Je n'ai plus de problème après une création ou une modif. depuis que j'ai ajouté l'initialisation dans un Sub Worksheet_SelectionChange()...(à moins que le passage de mon classeur de .xlsm sous 2010 .xls pour être accepté sur le forum introduise un nouveau problème...)

Cordialement

Pour oliv-

J'ai oublié : j'avais fait des essais en faisant sortir les noms des cases par des MsgBox dans le module Initialisation et tout était bon, même après un effacement...

Cordialement

Bonjour,

Citation:

Envoyé par Oliv-

Essaye en supprimant au préalable tous les checkbox

Juste pour info. : dans la nouvelle version que j'ai évoquée plus haut, j'ai un Sub qui crée (une seule fois à la conception ou après modification de de PlageModif) toutes les coches en face des cellules de PlageModif. Pour ce faire, j'efface d'abord toutes les anciennes coches, j'initialise puis je crée les nouvelles coches.

J'ai fait un essai et, effectivement, si l'on efface tout, cela fonctionne alors que si l'on n'efface que partiellement, le nouvelles coches ne sont pas actives...

Cordialement

Salut,
En fait j'y pensait sur mon vélo ce matin en me disant que peut être avec un DoEvents ca irait!

C'est quand même dingue, comme tu changes de cellule à la fin ton évenement Worksheet_SelectionChange devrait se déclencher !

Sinon ce code fonctionne sur ton ancienne version, et il est plus cohérent que le précédent.

edit : comme cela plutot

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
' --------------- Si l'on modifie la plage jaune -----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Sub Worksheet_Change(ByVal Cible As Range)
    Dim Vide As Boolean
    If Not Intersect(Cible, Range("PlageModif")) Is Nothing Then                                    ' Si la cellule modifiée est dans la plage prévue
        If Cible.Rows.Count <> 1 Then Exit Sub                                                            ' Si plusieurs cellules sélectionnées, on sort
        If Cible.Value = "" Then                                                                                    ' Si la cellule est vide (effacée ou rien rentré dedans)
            Call EffaceCoche(Cible)
            DoEvents
            ' Initialisation ' on efface la coche
        Else                                                                                                                   ' Si la cellule contient quelque chose
            Call VerifSiCoche(Cible, Vide)                                                                      ' on vérifie s'il y a une coche sur cette ligne
            If Vide = True Then                                                                                      ' Si la coche n'existe pas sur la ligne
                Call AjouteCoche(Cible)                                                                           ' on l'ajoute
            Else                                                                                                                   ' Si la coche existe,
                Exit Sub                                                                                                 ' on sort sans rien faire
            End If
        End If
        DoEvents
        Application.OnTime Now + TimeValue("00:00:01"), "ModuleCasesAcocher.Initialisation"                                                                             ' On se positionne sur la ligne suivante
    End If
    'MsgBox Application.EnableEvents
    Application.EnableEvents = True
 
End Sub
 
 
' --------------- Relance l'Init après chaque modif -----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
'Private Sub Worksheet_SelectionChange(ByVal Cible As Range)
'    Call Initialisation
'End Sub