XL 2013 Boucle sur Commandbars

[gonz19]

bonjour à tous

J'ai créer un fichier pour la réalisation de devis.
J'ai donc créer des menus qui viennent ce positionner dans l'onglet compléments.
Ci-dessous une partie du code de création des menus qui est appelé par un workbook_Open.

Public Const nombarreo As String = "Gestion"
Public Const nommenu As String = "Bibliothéque"
Public Const nommenu2 As String = "Base"
Public Const nommenu3 As String = "Facture"
Public Const nommenu5 As String = "Devis"
' menus d'Excel
Public Const nombarre As String = "Worksheet menu bar"
' Purpose   : création d'une barre d'outils
'---------------------------------------------------------------------------------------
Option Explicit

Sub Creer_Menu()
Dim NewMenu As CommandBarPopup
Dim NewSubMenu As CommandBarPopup
Dim NewButton As CommandBarButton

'ajouter un menu
Set NewMenu = Application.CommandBars(nombarre).Controls.Add _
(Type:=msoControlPopup)
NewMenu.Caption = nommenu
' 'ajouter un bouton au menu
 Set NewButton = NewMenu.Controls.Add(Type:=msoControlButton)

 With NewButton
 .Caption = "New client"
 '.BeginGroup = True
 .FaceId = 2475
 .OnAction = "newclient"
  End With
  'ajouter un bouton au menu
 Set NewButton = NewMenu.Controls.Add(Type:=msoControlButton)

 With NewButton
 .Caption = "client"
 '.BeginGroup = True
 .FaceId = 2475
 .OnAction = "client"
  End With
  'ajouter un bouton au menu
 Set NewButton = NewMenu.Controls.Add(Type:=msoControlButton)

 With NewButton
 .Caption = "Nouvelle REF"
 '.BeginGroup = True
 .FaceId = 2553
 .OnAction = "NewRef"
 End With
 ' 'ajouter un bouton au menu
 Set NewButton = NewMenu.Controls.Add(Type:=msoControlButton)

 With NewButton
 .Caption = "Importer REF"
 '.BeginGroup = True
 .FaceId = 2475
 .OnAction = "importerREF"
  End With
  'ajouter un bouton au menu
 Set NewButton = NewMenu.Controls.Add(Type:=msoControlButton)


 End Sub

Ca marche nickel.
Par contre il m'arrive d'ouvrir un ou plusieurs fichier en même temps. Avec cela m'ouvre une deuxième fenêtre, le programme exécute le workbook_ open, cela crée une deuxième fois les menus.
Maintenant si on ferme un des deux fichiers, par exemple le premier j'exécute un Workbook_BeforeClose
qui contient la macro de suppression des barres d'outils.

Sub Suppr_Menu()

Dim NewMenu As CommandBarPopup

On Error Resume Next
Set NewMenu = Application.CommandBars(nombarre).Controls(nommenu)
NewMenu.Delete
Set NewMenu = Application.CommandBars(nombarre).Controls(nommenu2)
NewMenu.Delete
Set NewMenu = Application.CommandBars(nombarre).Controls(nommenu3)
NewMenu.Delete
Set NewMenu = Application.CommandBars(nombarre).Controls(nommenu5)
NewMenu.Delete
End Sub

Mais problème je supprime les barres d'outils que sur (le fichier) la fenêtre en cour d'exécution. Donc dans le deuxième fichier j'ai encore mes deux barres de menu.
Donc à force d'ouvrir mes fichiers je me retrouve avec une ribambelle de menu ce qui est embêtant et à tendance à faire planter le programme.

Je voudrais donc trouver un moyen d'évité la création de plusieurs menu.
soit faire une boucle sur la suppression des différent menus
soit supprimer les menus exista,nt avant leur création.

merci d'avance de votre aide

 

[gonz19]

ok super mais moi ca marche pas chez moi je doit avoir un beug avec la version 2013 d'excel. Je vois que ca comme explication.

 

[Roland_M]

re

as-tu fais un essai pour voir les réactions à Activate/DeActivate en mettant des msgbox dans:
activate> MsgBox "Activate"
deactivate > MsgBox "DeActivate"

 

[gonz19]

je viens de refaire un essai en mettant les msgbox, les procédure sont bien lancées.

Quand j'ouvre un autre classeur les menus et icones sont supprimés. Je le ferme et je reviens donc au premier les menus sont créer sauf que dans cette fenêtre les menus n'avaient pas était supprimé je me retrouve donc avec deux fois les menus par contre les icçone avait bien était suprimé de la premier fenêtre.

 

[Roland_M]

re

alors ma conclusion c'est qu'il faut revoir pour la suppression des menus qui ne doit pas s'effectuer avec 2013 !?
probable encore des nouveautés incompatibles, ou tout simplement ton code qui ne fonctionne pas !?
il faudrait essayer en mettant les on error en rem pour voir s'il y a un déclenchement d'erreur !?

 

[Roland_M]

re

essaies de mettre tout ceci idem dans SupBarre

Sub SupBarre()
On Error Resume Next
Application.CommandBars(nombarreo).Delete
Application.CommandBars(nommenu).Delete
Application.CommandBars(nommenu2).Delete
Application.CommandBars(nommenu3).Delete
Application.CommandBars(nommenu4).Delete '< !?
Application.CommandBars(nommenu5).Delete
End Sub

 

[gonz19]

deuxième beug lié a mon avis:

si je lance mon fichier sans que excel soit ouvert le workbook_activate ne se lance pas.
si excel est deja ouvert et que je vais par ouvrir du menu excel le workbook_activate fonctionne a merveille

 

[Roland_M]

re

là effectivement ça se corse !?
ça ne peut pas être une histoire de sécurité car les macros s'exécutent ou pas en ouvrant depuis excel ou en cliquant sur le fichier depuis son dossier !

il faudrait effectuer une recherche sur le net
Excel 2013 problème WorkBook activate deactivate

 

[Roland_M]

Bonjour tout le monde,

essayer comme ceci !
ne pas oublier, pour éviter les problèmes avec les menus barre, on commence toujours par les supprimer au cas où !

Private Sub Workbook_Open()
Creer_Menu
Creer_Menu4
Creer_Menu5
Creer_Menu3
CreeBO
Bibliouverture
Sheets("gestion").Visible = False
Sheets("Base-0").Visible = False
Application.EnableEvents = True
End Sub

Private Sub Workbook_Activate()
Suppr_Menu '<<<
supbarre '<<<

Creer_Menu
Creer_Menu4
Creer_Menu5
Creer_Menu3
CreeBO
Bibliouverture
Sheets("gestion").Visible = False
Sheets("Base-0").Visible = False
Application.EnableEvents = True
End Sub

Private Sub Workbook_Deactivate()
Suppr_Menu
supbarre
End Sub

 

[gonz19]

merci pour la réponse c'est ce que j'ai tester ier soir mais que je n'est pas eu le temps de transmette.
dans workbook_activate je lance deux fois la macro supp_Menu au cas ou une deuxième trainerez encore. Ce matin j'ai testé de faire des boucles sur la suppression des menus jusqu'à temps qui y en est plus. Sans sucé pour moi. Donc je suis revenu à la méthode un peu bâtard de lancer plusieurs fois la macro supp_menu.
merci de ta collaboration à mon problème

 

[Roland_M]

Bonjour,

concernant ta routine ceci suffit en une seule macro !
Sub Suppr_Menu()
On Error Resume Next
Application.CommandBars(nombarre).Controls(nommenu).Delete
Application.CommandBars(nombarre).Controls(nommenu2).Delete
Application.CommandBars(nombarre).Controls(nommenu3).Delete
Application.CommandBars(nombarre).Controls(nommenu5).Delete
Application.CommandBars(nombarreo).Delete
Application.CommandBars(nommenu).Delete
Application.CommandBars(nommenu2).Delete
Application.CommandBars(nommenu3).Delete
Application.CommandBars(nommenu5).Delete
End Sub