un cadeau de + pour le forum

[p@cm@n]

Cadeau est peut être prétentieux de ma part, mais je souhaite partager ce qui fonctionne pour moi.

voici donc une barre d'outils personalisé et qui fonctionne parfaitement.
l'avantage c'est qu'il existe une commande administrateur qui permet de revenir à la barre initiale, mais pour cela il faut creer un Usf (userform) pour définir le code de dévérouillage.

je tiens quand même à préciser que le code original dont je me suis inspirer (pas celui qui suit) n'est pas de moi, en effet le code original imposait de creer un feuille Excel dans lequel on saisissait dans les première cellule de la colonne A les noms des différentes barres outils visibles par défaut, enfin celle que chaque utilisateur à défini pour lui (Standard,Formatting,Drawing,PivotTable,Visual Basic,Chart)
apres il suffisait de masquer cette feuille et décrire un code différent de celui que je vous propose et que j'utilise pour un de mes fichier.

voici le code:

Inserer ce qui suit dans un module standard

Sub MakeMenuBar()
' Nouvelle barre outils
'
Application.ScreenUpdating = False
Dim NewMenuBar As CommandBar
Dim NewMenu As CommandBarControl
Dim NewItem As CommandBarControl
Dim subNewItem As CommandBarButton

Call DeleteMenuBar
Set NewMenuBar = CommandBars.Add(MenuBar:=True)
With NewMenuBar
.Name = 'MyMenuBar'
.Visible = True
End With

Set NewMenu = NewMenuBar.Controls.Add(Type:=msoControlPopup)
NewMenu.Caption = '&Enregistrer'
Set NewItem = NewMenu.Controls.Add(Type:=msoControlButton)
With NewItem
.FaceId = 3
.Caption = 'Enregistrer_sous ...'
.OnAction = 'Enregistrer_sous'
.ShortcutText = 'Ctrl+S'
End With

Set NewMenu = NewMenuBar.Controls.Add(Type:=msoControlPopup)
NewMenu.Caption = '&Imprimer'

Set NewItem = NewMenu.Controls.Add(Type:=msoControlButton)
With NewItem
.FaceId = 4
.Caption = 'Imprimer'
.OnAction = 'Imprimer'
.ShortcutText = 'Ctrl+P'
End With

Set NewItem = NewMenu.Controls.Add(Type:=msoControlButton)
With NewItem
.FaceId = 109
.Caption = 'Aperçu avant impression'
.OnAction = 'Aperçu_avant_impression'
End With

Set NewMenu = NewMenuBar.Controls.Add(Type:=msoControlPopup)
NewMenu.Caption = '&Transmettre'

Set NewItem = NewMenu.Controls.Add(Type:=msoControlButton)
With NewItem
.FaceId = 325
.Caption = 'Envoyer ...'
.OnAction = 'Envoyer_classeur'
End With

Set NewMenu = NewMenuBar.Controls.Add(Type:=msoControlPopup)
NewMenu.Caption = '&?'

Set NewItem = NewMenu.Controls.Add(Type:=msoControlPopup)
With NewItem
.Caption = 'Accès Administrateur'
.BeginGroup = True
End With

Set subNewItem = NewItem.Controls.Add(Type:=msoControlButton)
With subNewItem
.FaceId = 277
.Caption = 'Déverrouiller la barre de menu'
.OnAction = 'Mot_de_Passe'
End With

Set NewItem = NewMenu.Controls.Add(Type:=msoControlButton)
With NewItem
.FaceId = 984
.Caption = 'Aide Utilisateur'
.OnAction = 'Aide'
End With

Set NewItem = NewMenu.Controls.Add(Type:=msoControlButton)
With NewItem
.FaceId = 362
.Caption = 'A propos de ...'
.OnAction = 'Affichage_Informations'
End With
Application.CommandBars('MyMenuBar').Controls.Add Type:= _
msoControlButton, ID:=444, Before:=25
Application.CommandBars('MyMenuBar').Controls.Add Type:= _
msoControlButton, ID:=445, Before:=26

NewMenuBar.Protection = msoBarNoMove + msoBarNoCustomize
NewMenuBar.Visible = True

End Sub
Sub DeleteMenuBar()
On Error Resume Next
CommandBars('MyMenuBar').Delete
On Error GoTo 0
End Sub


dans ThisWorkbook mettre ceci:

Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)

' Demande de confirmer fermeture du classeur
' et restauration barre outils initiale
'
If MsgBox('Avez-vous effectuez votre sauvegarde ?' _
& Chr(10) & 'Confirmez-vous la fermeture du classeur ?', _
vbQuestion & vbYesNo, 'Fermer le classeur') = vbYes Then
Application.DisplayFormulaBar = True
Application.DisplayStatusBar = True
Application.CommandBars('Drawing').Visible = True
Application.CommandBars('Chart').Visible = True
Application.CommandBars('PivotTable').Visible = True
Application.CommandBars('Visual Basic').Visible = True
Application.CommandBars('Formatting').Visible = True
Application.CommandBars('Standard').Visible = True
Saved = True
Else
Application.DisplayFormulaBar = False
Application.DisplayStatusBar = False
Application.CommandBars('Drawing').Visible = False
Application.CommandBars('Chart').Visible = False
Application.CommandBars('PivotTable').Visible = False
Application.CommandBars('Visual Basic').Visible = False
Application.CommandBars('Formatting').Visible = False
Application.CommandBars('Standard').Visible = False
Cancel = True
End If
End Sub

Private Sub Workbook_Deactivate()
On Error Resume Next
Application.DisplayFormulaBar = True
Application.DisplayStatusBar = True
Application.CommandBars('Drawing').Visible = True
Application.CommandBars('Chart').Visible = True
Application.CommandBars('PivotTable').Visible = True
Application.CommandBars('Visual Basic').Visible = True
Application.CommandBars('Formatting').Visible = True
Application.CommandBars('Standard').Visible = True
Call DeleteMenuBar

End Sub

Private Sub Workbook_Open()
On Error Resume Next
Application.CommandBars('Drawing').Visible = False
Application.CommandBars('Chart').Visible = False
Application.CommandBars('PivotTable').Visible = False
Application.CommandBars('Visual Basic').Visible = False
Application.CommandBars('Formatting').Visible = False
Application.CommandBars('Standard').Visible = False
Application.DisplayFormulaBar = False
Application.DisplayStatusBar = False
Call MakeMenuBar

Range('A1').Select

End Sub

amicalement bonne prog et @+