Perte de macro aprés opérations sur objet

[Marcoleschams]

Bonjour,

Tout d'abord, je ne sais pas si je peux me qualifier de "débutant", il y a temps de temps que je "bidouille" en VBA ! Disons que je me forme comme le fait un autodidacte, aussi les explications que j'attends, nécessitent que l'on me mâche un peu la démarche.

J'élabore un document excel qui nécessite de gérer des boites à bouton. Ce document est assez lourd pour le présenter ici, aussi j'ai construit un autre document excel (appeler "essai case à cocher.xls") uniquement à fin de travailler sur le problème.

Avec les renseignements que j'ai pris ici :
Les meilleurs sources pour Excel - Club d'entraide des développeurs francophones - Club des décideurs et professionnels en Informatique
VBA et les collections d'objets.
J'ai une procédure (macro InitOption) qui me permet de créer un événement (mettre la cellule au droit de la case à cocher à la valeur vrai ou faux en fonction de la présence de la coche ou pas).
A l'ouverture du document, celle-ci marche très bien et me satisfait.
Mais cette procédure (macro InitOption) perd toute son activité dés que je crée ou supprime des cases à cocher malgré son rechargement dans la fonction de création ou de suppression, mais aussi quand je lance l'éditeur VBA.
J'ai affecté cette macro à une commande clavier et c'est uniquement avec celle-ci que j'arrive à la réactiver. Naturellement, ce n'est pas avec un raccourcie clavier que je veux que cela fonctionne.
A fin d'essai, dans le document, j'ai mis un bouton de commande ("Met cases à cochées") affectée à une macro (Private Sub CommandButton1_Click()) qui crée 5 checkbox appelées A1, A2,…,A5 dans les cellules B 1 à B5 et un autre bouton ("Défait les cases à cochées") qui me les supprime. (Macro : Private Sub CommandButton2_Click())
Ces 2 macros font le travail que je demande et retourne dans "InitOption", mais cette dernière opération est, comme je le disais, sans effet.

Voici mon VBA :
Dans Feuil1 (Feuil1) &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
Private Sub CommandButton1_Click()
CreCase
Cells(1, 3).Select
ThisWorkbook.Workbook_Open 'Je relance initoption
End Sub

Private Sub CommandButton2_Click()
EffaceCase
Cells(1, 3).Select
ThisWorkbook.Workbook_Open 'Je relance initoption
End Sub

Function CreCase()
Dim Chbx As OLEObject, j As Integer
On Error Resume Next
For j = 1 To 5
Set Chbx = ActiveSheet.OLEObjects("a" & j)
If Err.Number = 1004 Then 'Vérifie si cela est correct
Worksheets("Feuil1").OLEObjects.Add ClassType:="Forms.CheckBox.1", _
Link:=False, DisplayAsIcon:=False, Left:=180, Top:=10, Width:=18.75, Height:=12
Set Chbx = ActiveSheet.OLEObjects("CheckBox1")
With Chbx
.Top = Cells(j, 1).Top
.Left = Cells(j, 2).Left
.Object.Caption = "" 'Retire le nom de la case
.Object.SpecialEffect = 0 'Met une ombre
.Name = "A" & j 'le renome en A quelque chose
End With
Else
MonMessage ("créer ")
j = 5
End If
Next j
End Function

Function EffaceCase()
Dim Chbx As OLEObject, j As Integer
On Error Resume Next
For j = 1 To 5
Set Chbx = ActiveSheet.OLEObjects("a" & j)
If Err.Number <> 1004 Then 'Vérifie si cela est correct
Chbx.Delete
Cells(j, 1) = ""
Else
MonMessage ("effacer")
j = 5
End If
Next j
End Function

Function MonMessage(LeMot As String)
MsgBox (Chr(13) & "***********************************" & Chr(13) & _
"***** Il n'y a rien à " & LeMot & " ****" & Chr(13) & _
"***********************************")
End Function

Dans ThisWorkbook &&&&&&&&&&&&&&&&&&&&&&&&&&&&&
Option Explicit
Public Sub Workbook_Open()
InitOption
End Sub

Dans Module1&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
Option Explicit
Public Collect As Collection
Public Sub InitOption()
Dim Obj As OLEObject
Dim Cl As Classe1
Set Collect = New Collection
'boucle sur les objets de la Feuil1
For Each Obj In Feuil1.OLEObjects
'verifie s'il s'agit d'un Checkbox
If TypeOf Obj.Object Is MSForms.CheckBox Then
Set Cl = New Classe1
Set Cl.CheckBoxGroup = Obj.Object
Collect.Add Cl
End If
Next Obj
MsgBox ("initialisation faite")
End Sub

Dans Classe1&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
Option Explicit
Public WithEvents CheckBoxGroup As MSForms.CheckBox
Public Sub CheckBoxGroup_Click()
Cells(CheckBoxGroup.TopLeftCell.Row, 1) = CheckBoxGroup.Value
Cells(1, 3).Select
End Sub

Je veux bien faire parvenir ce document xls si cela peut aider.

Merci d'avance Marc

 

[Caillou]

Re : Perte de macro aprés opérations sur objet

Bonjour,

J'ai une procédure (macro InitOption) qui me permet de créer un événement (mettre la cellule au droit de la case à cocher à la valeur vrai ou faux en fonction de la présence de la coche ou pas).

Pourquoi ne pas utiliser la propriété LinkedCell de l'objet CheckBox ?

Caillou

 

[Marcoleschams]

Re : Perte de macro aprés opérations sur objet

Bonjour,

Pourquoi ne pas utiliser la propriété LinkedCell de l'objet CheckBox ?

Caillou

Merci.
Je n'utilise pas cette propriété parce que je ne la connais pas, mais j'ai fait quelques essais.
Cela semble interressant, il faut certainement que je travaille un peu plus cette solution.
Par contre je me demande comment gérer ces cases.
En effet, je n'arrive pas à afficher ses propriétés (en faisant " Boite à outils controle" et "propriétés"), ne serais-ce que pour changer le nom ou faire une ombre portée. Je n'arrive pas non plus à l'effacer.
La création de telle cases en masse semble faisable, (pour la suppression, je verrai)
Enfin, voilà je vais essayer de comprendre ce type de création, mais pendant ce temps je préfére laisser ma question ouverte car j'aimerai bien trouver la solution pour réactiver mon InitOption.
Toutes les choses que je pourrai apprendre sur la méthode LinkedCell mais aussi les réponses à mon problème ne pourra que m'apprendre tous ça.

 

[skoobi]

Re : Perte de macro aprés opérations sur objet

Bonjour Marcoleschams,

Je veux bien faire parvenir ce document xls si cela peut aider.

C'est à mon avis nécessaire.

Petite précision: quand tu écris du code dans un message écris-le entre les balises de code prévu (dans le mode avancé de la réponse, icone "dièse")

 

[Marcoleschams]

Re : Perte de macro aprés opérations sur objet

Bonjour Marcoleschams,

Petite précision: quand tu écris du code dans un message écris-le entre les balises de code prévu (dans le mode avancé de la réponse, icone "dièse")

C'est vrai je suis désolé.

Je joint le dossier ici. Ou plutôt, je vais essayer

La macro en question avec les touches Ctrl + d

 

[Pierrot93]

Re : Perte de macro aprés opérations sur objet

Bonjour à tous

essaye peut en modifiant le code présent dans le module standard comme suit :

'dans un module standard
Option Explicit
Public C1() As New Classe1
Public Sub InitOption()
Dim Obj As OLEObject, i As Integer
'boucle sur les objets de la Feuil1
For Each Obj In Feuil1.OLEObjects
    'verifie s'il s'agit d'un Checkbox
    If TypeOf Obj.Object Is MSForms.CheckBox Then
        i = i + 1
        ReDim Preserve C1(1 To i)
        Set C1(i).CheckBoxGroup = Obj.Object
    End If
Next Obj
MsgBox ("initialisation faite")
End Sub

bonne journée
@+

 

[Marcoleschams]

Re : Perte de macro aprés opérations sur objet

Merci Pierrot93.
Cela a le même résultat.
J'ai l'impression que l'appelle aux fonctions CreCase et EffaceCase n'est pas terminés et que pour autant elles appelle la sub InitOption.
Cela est trés remarquable avec la fonction CreCase, où la boite de message indique "initialisation faite" alors que la construction des cases à cocher semble inachevée.
En cherchant plus loin, j'ai court circuité la commande "Worksheets("Feuil1").OLEObjects.Add" de la fonction CreCase et là, ma sub InitOption accroche bien. C'est donc bien l'entrée dans la création ou la suppréssion des cases qui empêche la prise en compte de InitOption, sans empêcher sa lecture pour autant.
J'ai l'impression qu'il me faudrait une ligne de commande qui achève la création ou la suppréssion des cases avant d'appeler InitOption. C'est pour cela qu'aprés la fonction CreCase et SupprimeCase j'avais sélectionné une cellule ("Cells(1, 3).Select"), mais cela n'a rien changé.
Autre chose que j'ai remarqué c'est qu'aprés avoir créé ou supprimé des cases et que je coche une case les icones "propriété" et "visualiser le code" de la boite à outils contrôle deviennent grisées.
Bizarre, bizarre.

 

[Pierrot93]

Re : Perte de macro aprés opérations sur objet

Re

essaye en modifiant le code du bouton comme suit :

Private Sub CommandButton1_Click()
CreCase
Cells(1, 3).Select
Application.OnTime Now + TimeValue("00:00:01"), "InitOption"
End Sub

@+

 

[Marcoleschams]

Re : Perte de macro aprés opérations sur objet

Ah sacré Pierrot !!!
C'est exactement ce que j'ai aussi trouvé, et ça marche, mais ce qui est fort c'est qu'au même moment que je lançais le forum pour faire part de ma découverte, ma messagerie Lotus m'informait de ton message.
Donc effectivement, j'attends 1 seconde afin que les fonctions CreCase et EffaceCase puissent s'achever. Et ainsi je peux recharger mon InitOption.
De plus, pour gagner du temps en évitant les mises à jour écran, j'ai rajouté la fonction
Application.ScreenUpdating = False et true pour entourer chaque boucles.
Du coup maintenant je cherche s'il n'existe pas une fonction qui détecte la fin d'execution de fonction, cela me semblerai une solution plus saine.
D'aprés toi (ou vous) dois-je faire un nouveau post ou peut-on continuer ici ?
Encore que, je vais d'abord chercher avant de m'adresser ici.
Je te remercie

 

[Pierrot93]

Re : Perte de macro aprés opérations sur objet

Re,

perso vois pas trop de solution, tu peux peut être mettre un "msgbox" dans le code de ton bouton, mais pas sur que cela te fasse gagner du temps....

tu peux continuer ce post ici, peut être que quelqu'un d'autre qui passera aura une autre vision du problème...

bonne soirée
@+