Discussion :

[wushual1]

Bonjour,

Je développe actuellement une application qui crée un menu personnalisé lors de son ouverture et le supprime lors de sa fermeture.

Mais, je suis parfois amené à en ouvrir plusieurs qui utilisent le même menu.
Donc, lors de l'ouverture, je le supprime tout le temps (le menu personnalisé) et le recrée à l'identique et lors de la fermeture.

J'aimerai tester s'il existe, dans les autres classeurs ouverts ce fameux menu personnalisé et, donc, ne pas le supprimer si c'est le cas (voir plutôt le cacher) et le supprimer sinon...
Pour ce faire, j'utilise ce code dans Thisworkbook avec le déclencheur Workbook_BeforeClose (mon menu se nomme "Miodos" et se place juste avant le menu d'aide):

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
Private Sub Workbook_BeforeClose(Cancel As Boolean)
'il faut tester si dans les autres classeurs ouvert il existe un objet Miodos dans le menu
Dim MiodosExiste As Boolean
MiodosExiste = False
For Each w In Workbooks
    Dim cb As CommandBarPopup
    For Each cb In w.CommandBars(1)
        If UCase(cb.Caption) = UCase("Miodos") Then
            MiodosExiste = True
        End If
    Next cb
Next w
'si il y en a un, on ne fait rien sinon on 'efface
If Not MiodosExiste Then
    Call Menu.EffacerMenu
End If
ThisWorkbook.Save
End Sub

Mais, lors de son execution, à la ligne "For Each cb In w.CommandBars(1)", il me met "objet requis".

Pouvez-vous me trouver une solution? ou une piste de résolution du problème?

Merci d'avance ;-p

[Theocourant]

Bonjour,

Si tu pouvais penser à utiliser les balises pour présenter ton code ainsi que l'indenter ce serait plus clair à lire. Merci. (tu peux éditer ton sujet pour le faire).


Pour ton problème, je pense que cela vient de l'utilisation de la collection des commandbars...

Essaie le code suivant :

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
Private Sub Workbook_BeforeClose(Cancel As Boolean)
'il faut tester si dans les autres classeurs ouvert il existe un objet Miodos dans le menu
Dim MiodosExiste As Boolean
Dim cb As CommandBarPopup   'Pas de déclaration au milieu du code tu risques de t'embrouiller

    MiodosExiste = False
    For Each w In Workbooks
        For Each cb In w.CommandBars
            If UCase(cb.Caption) = UCase("Miodos") Then
                MiodosExiste = True
            End If
        Next cb
    Next w

    'si il y en a un, on ne fait rien sinon on 'efface
    If Not MiodosExiste Then
        Call Menu.EffacerMenu
    End If

    ThisWorkbook.Save

End Sub

Corrections en rouge

+

Théo

[wushual1]

Après tes modifications, il me met:
"Erreur d'execution 424: Objet requis"

Le debugger me surligne la ligne:

Code :

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

For Each cb In w.CommandBars

D'où es-ce que ce problème peut bien venir?

[wushual1]

Peut être voulez-vous mon code de création du menu?
Au cas où:

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
43
44
45
46
47
48
49
 
Sub CreerMenu()
Dim HelpMenu As CommandBarControl
Dim NewMenu As CommandBarPopup
Dim MenuItem As CommandBarControl
Dim submenuitem As CommandBarButton
 
'supprimer menu s'il existe deja
Call EffacerMenu
 
'Trouver le menu d'aide
Set HelpMenu = CommandBars(1).FindControl(ID:=30010)
 
If HelpMenu Is Nothing Then
'ajoute le menu à la fin
Set NewMenu = CommandBars(1).Controls.Add _
(Type:=msoControlPopup, _
temporary:=True)
Else
'ajoute le menu devant l'aide
Set NewMenu = CommandBars(1).Controls.Add _
(Type:=msoControlPopup, _
before:=HelpMenu.Index, _
temporary:=True)
End If
 
'ajoute une legende pour le menu
NewMenu.Caption = "&Miodos"
NewMenu.OnAction = "Menu.ActDesact"
 
'Premier élément de menu
Set MenuItem = NewMenu.Controls.Add _
(Type:=msoControlButton)
With MenuItem
    .Caption = "&Naviguer"
    .FaceId = 166
    .OnAction = "Menu.LancerNavigateur"
End With
 
'Deuxieme élément de menu
Set MenuItem = NewMenu.Controls.Add _
(Type:=msoControlButton)
With MenuItem
    .Caption = "&Valider critères généraux"
    .FaceId = 163
    .OnAction = "Menu.ValiderCriteresGeneraux"
End With
 
End Sub

[Theocourant]

As-tu essayé la réponse et le code que je t'ai donné ?????

Théo

[wushual1]

Oui et je t'ai posté le résultat de ta réponse...

Après tes modifications, il me met:
"Erreur d'execution 424: Objet requis"

Le debugger me surligne la ligne:
Code :

For Each cb In w.CommandBars

[Theocourant]

Oups désolé... j'ai loupé une réponse...

En relisant ton code je vois que ce n'est pas une CommandBar dans son ensemble que tu rajoutes mais juste un menu ... je pense que cela risque de compliquer la tâche... car il faudra que tu recherches dans chaque CommandBar n°1 s'il existe un contrôle ayant le caption que tu as donné... enfin on devrait peut-être s'en sortir avec l'aide en ligne.

Je regarde cela et je reviens

Théo