For i = 1 To Sheets.Count
' ****code****
Set objBut = Sheets(i).Buttons.Add(PosG, PosH, Longueur, Hauteur)
Sub InsererDesBoutons()
Dim objBut As Object
Dim i As Integer
LigDeb = 2
With Range("B" & LigDeb)
PosG = .Left
PosH = .Top
End With
Hauteur = 50
Longueur = 150
ActiveSheet.Unprotect Password:="sandman"
ActiveWorkbook.Unprotect Password:="sandman"
With ActiveSheet.Buttons.Add(PosG, PosH, Longueur, Hauteur)
.OnAction = "ArrêtProtec" 'Nom d'un sub
.Caption = "Déprotéger Feuil"
End With
End Sub
Sub InsererDesBoutons()
Dim objBut As Object
Dim i As Integer
LigDeb = 2
With ActiveWorkbook
.Unprotect Password:="sandman"
For i = 1 To .Worksheets.Count
With .Worksheets(i)
With .Range("B" & LigDeb)
PosG = .Left
PosH = .Top
End With
Hauteur = 50
Longueur = 150
.Unprotect Password:="sandman"
With .Buttons.Add(PosG, PosH, Longueur, Hauteur)
.OnAction = "ArrêtProtec" 'Nom d'un sub
.Caption = "Déprotéger Feuil"
End With
End With
Next i
End With
End Sub
Sub InsererDesBoutons()
Dim objBut As Object
Dim i As Integer
Dim Test_Buttons As Boolean
ligdeb = 2
With ThisWorkbook
.Unprotect Password:="sandman"
For i = 1 To .Worksheets.Count
With .Worksheets(i)
With .Range("B" & ligdeb)
PosG = .Left
PosH = .Top
End With
Hauteur = 50
Longueur = 150
If Not .Buttons.Count = 0 Then
For Each objBut In .Buttons
If objBut.Name = "Deprotect" Then Test_Buttons = True: Exit For
Next objBut
End If
If Not Test_Buttons Then
.Unprotect Password:="sandman"
Set objBut = .Buttons.Add(PosG, PosH, Longueur, Hauteur)
With objBut
.Name = "Deprotect"
.OnAction = "ArrêtProtec" 'Nom d'un sub
.Caption = "Déprotéger Feuil"
End With
End If
End With
Next i
End With
End Sub
je le laisse faire.@juvaxe , la solution que tu décris me paraît pleinement répondre à mes besoins
Sub Creation_menu_Spike()
'
Dim Barre As CommandBar
Dim Groupe As CommandBarPopup, PopUp As CommandBarPopup
Dim Bouton As CommandBarButton
Dim Nombarre As String
' Nom donné à la barre de menu ... à personnaliser (comme tout les noms donnés bien évidemment
'
Nombarre = "Menu dédié CORPROD " & Mid(ThisWorkbook.Path, 4, 4)
' L'option True lors de la création du menu va faire que ce menu va disparaitre lors de le fermeture d'Excel.
' Il faut donc prévoir le cas ou le classeur est fermé et ouvert dans la foulée sans passer par une fermeture d'excel.
' Dans cette hypothèse le menu est encore disponible et ne doit donc
' pas donner lieu à une nouvelle création => d'où l'Exit Sub ci-dessous
For Each Barre In Application.CommandBars
If Barre.Name = Nombarre Then
Barre.Visible = True
Exit Sub ' On vient de traouver le menu, inutile de le recréer
End If
Next Barre
' Création de la barre de menu
'
Set Barre = Application.CommandBars.Add(Nombarre, 1, , True) ' le "True" undique une barre temporaire
' ' qui est supprimée à la femeture de l'application (exel)
' ' pour la conserver mettre True
Barre.Visible = True
Barre.Left = 30
'
'
'
'Deux solutions : au Choix. A titre d'exemple; il faudra supprimer la formule non retenue
' Formule 1 : deux boutons séparés
'
' 1er bouton
Set Bouton = CommandBars(Nombarre).Controls.Add(Type:=msoControlButton) ' , ID:=280)
Bouton.Style = msoButtonCaption
Bouton.Caption = "Mettre protection " 'Nom du bouton
Bouton.OnAction = "Protect_On" 'Définit la macro associée au bouton.
' 2ème bouton
Set Bouton = CommandBars(Nombarre).Controls.Add(Type:=msoControlButton) ' , ID:=280)
Bouton.Style = msoButtonCaption
Bouton.Caption = "Enlever protection " 'Nom du bouton
Bouton.OnAction = "ArrêtProtec" 'Définit la macro associée au bouton.
'
'Formule 2 : deux boutons regroupés
'
Set Groupe = Barre.Controls.Add(msoControlPopup)
Groupe.Caption = " Protection des feuilles "
Groupe.Width = 70
Set Bouton = Groupe.Controls.Add(msoControlButton)
Bouton.Caption = "Activer"
Bouton.OnAction = "Protect_On"
Set Bouton = Groupe.Controls.Add(msoControlButton)
Bouton.Caption = "Enlever"
Bouton.OnAction = "ArrêtProtec"
'
'
'
End Sub
Sub Protect_On()
' routine de protection des feuilles du classeur
'Dim Feuil As Excel.Worksheet
'For Each Feuil In ThisWorkbook.Worksheets
' Feuil.Protect Password:="sandman", DrawingObjects:=True, _
' Contents:=True, Scenarios:=True, UserInterfaceOnly:=True
' 'Feuil.EnableSelection = xlNoSelection
'Next Feuil
End Sub
Sub Protect_Off()
' La protection des feuilles va être levée
Dim Feuil As Excel.Worksheet
For Each Feuil In ThisWorkbook.Worksheets
Feuil.Unprotect "sandman"
' ActiveWorkbook.Unprotect "secret"
Next Feuil
End Sub