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

 

[Roland_M]

Bonsoir,

avec des menus bars il faut penser à:

Private Sub Workbook_Activate()'ceci au retour sur ce classeur
'création des menus
End Sub

Private Sub Workbook_Deactivate()'ceci si on passe sur un autre classeur
'suppression des menus
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)'ceci à la fermeture de ce classeur
'suppression des menus
End Sub

 

[gonz19]

merci pour cette réponse
workbook_desactivate supprime bien mes barres de menu mais dans le fichier qui s'ouvre.
donc il ne faut pas mettre de Worbook_Activate 'création des menus
ca devrait résoudre mon problème (faut que je test un peu plus)

 

[Roland_M]

re

non ! tu supprimes Open !

 

[gonz19]

Je reviens après plusieurs essaies.
Sous excel 2013 il ne faut pas utiliser la commande Workbook_activate sous peine d'avoir plusieurs fois les menus de créer. Quand on change de fenêtre Workbooks_deactivate supprime la barre dans la nouvelle fenêtre mais pas dans le classeur contenant les barre d'outils. (chaque classeur ouvre une "fenêtre excel")

Par contre sous excel 2007 (car je travail aussi sur un pc portable un peux plus vieux) c'est le contraire les différents fichiers sont ouvert dans la même "fenêtre excel" du coup il ne faut plus utiliser le Open mais Activate comme l'a précisé @Roland_M dans son dernier message.

Bref c'est compliqué. Du coup ca va marcher correctement que sur un de mes deux PC.
J'ai aussi un autre problème sous 2007 mon Workbooks_Open marche nickel mais pas sous 2013. le workbook_Open marche quand il a envie. j'ai jamais de beug, il n'est tous simplement pas exécuté.

 

[Roland_M]

re bonjour tout le monde ,

je n'y comprends absolument rien ,car j'utilise toujours ceci pour mes classeurs depuis des années, je n'ai aucun souci !?

Private Sub Workbook_Activate()
BarMenuPersoCreation
End Sub
Private Sub Workbook_Deactivate()
BarMenuPersoDelete
End Sub

 

[gosselien]

Bonjour,

voilà ce que j'utilse depuis des années en 2003-2007-2010-2016 au boulot

Option Explicit
Const APP_NAME = "Menu Adeps"
' 2 eme menu ------ doit se placer à la droite du menu Développeur (2010-2016)
'-----------------------------------------------------
Sub BarOpenAdeps()
Dim xBar As CommandBar
Dim xBarPop As CommandBarPopup
Dim bCreatedNew As Boolean
Dim n As Integer, m As Integer
Dim k As Integer, Auteur As String
On Error Resume Next
Set xBar = CommandBars(APP_NAME)

On Error GoTo 0
If Not xBar Is Nothing Then
    xBar.Delete
    Set xBar = Nothing
End If
Set xBar = Application.CommandBars.Add
With xBar
    .Visible = True
    .Name = APP_NAME
    Set xBarPop = .Controls.Add(Type:=msoControlPopup, Temporary:=True, Before:=1)
End With

With xBarPop
    .Caption = APP_NAME
    .Visible = True
End With

With xBarPop
    With .Controls.Add(Type:=msoControlButton)
        .OnAction = "GroupColorAdeps"
        .Caption = "REGROUPER IDENTIQUES PAR COULEUR"
        .Style = msoButtonIconAndCaption
        .FaceId = 340
    End With
  
        With .Controls.Add(Type:=msoControlButton)
        .OnAction = "MajusculesRapideAdeps"
        .Caption = "METTRE EN MAJUSCULES"
        .Style = msoButtonIconAndCaption
        .FaceId = 134
    End With
  
        With .Controls.Add(Type:=msoControlButton)
        .OnAction = "Ligne1Adeps"
        .Caption = "BLOQUER LIGNE1"
        .Style = msoButtonIconAndCaption
        .FaceId = 319
    End With
  
   
End With

End Sub
'-----------------------------------------------------

et
Private Sub Workbook_Open()
BarOpenAdeps
End Sub

dans mon "personnal.xlsb" qui arrive en caché

 

[Roland_M]

re

voir ici ce classeur, il utilise ce dont je t'ai expliqué dans mon message précédent !
tu essaies et tu dis quoi !?
ça fonctionne sous 2007 et même 2003

https://www.excel-downloads.com/threads/resolu-recherche-windows-a-partir-dexcel.20003552/

 

[gonz19]

ce qui est hallucinant c'est que j'ai testé ton fichier et tout marche.
Mais si je fais la même chose sur mon fichier ca marche pas.
je mais en pièce jointe le fichier complet si éventuellement tu peux tester. (une macro ce lance à l'ouverture pour indiquer l'emplacement de fichiers tu peux utiliser les croix pour sortir).

ps: je viens de m'apercevoir que dans mon premier message j'ai pas mis les lignes de cote qui correspondait à mon problème. (j'ai remplacé) désolé

merci d'avance

 

[Roland_M]

re

j'ai un plantage sur:

Private Sub Workbook_Activate()
workb2ookOpen
End Sub

à mon avis lorsque ton classeur est actif tu en charges ou actives un autre !?
c'est ça ton problème !
ne pas oublier que Sub Workbook_. . .() c'est ce classeur et pas un autre !
c'est pareil lorsqu'on veut absolument s'adresser au classeur qui contient les codes,
il faut impérativement utiliser ThisWorkbook !

 

[Roland_M]

re

'tu devrais avoir ceci:

Private Sub Workbook_Activate()
Cree_Menu '< à toi de voir
End Sub

Private Sub Workbook_Deactivate()
Suppr_Menu
End Sub

'quand à workb2ookOpen il ne doit pas être au bon endroit ! je sais pas ce que tu fais exactement !?

EDIT: chaque menu doit être indépendant à chaque classeur !
de cette manière Activate et Deactivate s'exécute tout simplement dans chacun indépendamment !
ne surtout pas créer tous les menus dans un seul classeur !

 

[gonz19]

un 2 c'est glissé au milieu de "workbookOpen" ca appel une macro qui est dans me M_workbook
je m'en suis pas rendu compte désolé

 

[Roland_M]

re

ok, mais n'empêche que je ne vois pas de:
Private Sub Workbook_Activate()
Cree_Menu '< à toi de voir
End Sub

il n'y a que ceci:
Private Sub Workbook_Deactivate()
Suppr_Menu
End Sub

car de cette manière ça doit fonctionner, c'est l'exemple de mon fichier !
les routines pour création/suppression

'       MODULE MENU ARBOR     .

Private Const NomMenuPerso$ = "Répertoires/Fichiers"

Public Sub BarMenuPersoDelete()
On Error Resume Next: Application.CommandBars(NomMenuPerso$).Delete
End Sub

Public Sub BarMenuPersoCreation()
BarMenuPersoDelete

MenuBar: 'ci-dessous choix Position:=msoBar!?! Left/Right/Top/Bottom/Floating
Set NewBarre = Application.CommandBars.Add(Name:="Répertoires/Fichiers", Position:=msoBarLeft, MenuBar:=False, Temporary:=True)
Set BarMenu = NewBarre.Controls.Add(msoControlPopup)
BarMenu.Caption = Space(20) & "Menu" & Space(20)
For I = 1 To 8 'le 9'choix pour sauvegarde feuille(à la demande d'un forumeur)
Set ChoixMenu = BarMenu.Controls.Add(msoControlButton)
ChoixMenu.Caption = Choose(I, "Arborescence seule", "* Arborescence+Fichiers", "* Masquer les Fichiers", "* Afficher les Fichiers", "Liste des Reps\sousRep", "Liste des Fichiers", "Recherche Fichiers", "Vider La Feuille", "Save Feuille Arborescence")
ChoixMenu.OnAction = Choose(I, "LoadArboresSeul", "LoadArboresFich", "MasquerLesFichiers", "AfficherLesFichiers", "LoadDossiers", "LoadFichiers", "FindFichiers", "VideReinitLaFeuilArbor", "SaveFeuilArbor")
Next
NewBarre.Visible = True
End Sub

 

[gonz19]

j'ai repris le fichier je suis sur qu'il y a un Workbook_Activate qui ne marche pas bien chez moi.
les sub menu sont dans le module M6_menu la syntaxe de création et presque identique a la tiennent un peux moins concaténé.
toutes les sub marche correctement ormi avec les activate ou deactivate

Private Sub Workbook_Activate()

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

End Sub

 

[Roland_M]

re

je viens d'essayer ton classeur tout est ok au niveau des menus bar !
j'ai une routine pour les afficher, et quand j'active d'autres classeurs tes menus sont bien supprimés
et lorsque je retourne sur ton classeur les menus sont bien recréés !
pour moi, tout me semble OK !?