c'est marrant,,, et devient génant !!

Bonsoir Macpoy
ce code permet de créer un menu deroulant en haut dans la barre standard d'excel je l'épreter quelque part tu poura gérer tes feuilles comme tu veux à adapter.

' macros written 27. November 1998 by Ole P. Erlandsen, ope@st.telia.no

Option Explicit

Sub CreateMenu()
' creates a new menu.
' can also be used to create commandbarbuttons
Dim cbMenu As CommandBarControl, cbSubMenu As CommandBarControl
RemoveMenu ' delete the menu if it already exists
' create a new menu on an existing commandbar (the next 6 lines)
Set cbMenu = Application.CommandBars(1).Controls.Add(msoControlPopup, , , , True)
With cbMenu
.Caption = '&My menu'
.Tag = 'MyTag'
.BeginGroup = False
End With
' or add to an existing menu (use the next line instead of the previous 6 lines)
'Set cbMenu = Application.CommandBars.FindControl(, 30007) ' Tools-menu
If cbMenu Is Nothing Then Exit Sub ' didn't find the menu...

' add menuitem to menu
With cbMenu.Controls.Add(msoControlButton, 1, , , True)
.Caption = 'Feuil1'
.OnAction = ThisWorkbook.Name & '!Macroname'
End With
' add menuitem to menu
With cbMenu.Controls.Add(msoControlButton, 1, , , True)
.Caption = 'Feuil2'
.OnAction = ThisWorkbook.Name & '!Macroname'
End With

' add a submenu
Set cbSubMenu = cbMenu.Controls.Add(msoControlPopup, 1, , , True)
With cbSubMenu
.Caption = 'Submenu1'
.Tag = 'SubMenu1'
.BeginGroup = True
End With
' add menuitem to submenu (or buttons to a commandbar)
With cbSubMenu.Controls.Add(msoControlButton, 1, , , True)
.Caption = '&Submenu Feuil1'
.OnAction = ThisWorkbook.Name & '!Macroname'
.Style = msoButtonIconAndCaption
.FaceId = 71
.State = msoButtonDown
End With
' add menuitem to submenu (or buttons to a commandbar)
With cbSubMenu.Controls.Add(msoControlButton, 1, , , True)
.Caption = '&Submenu Feui2'
.OnAction = ThisWorkbook.Name & '!Macroname'
.Style = msoButtonIconAndCaption
.FaceId = 72
.Enabled = False
End With

' add a submenu to the submenu
Set cbSubMenu = cbSubMenu.Controls.Add(msoControlPopup, 1, , , True)
With cbSubMenu
.Caption = '&Submenu2'
.Tag = 'SubMenu2'
.BeginGroup = True
End With
' add menuitem to submenu submenu
With cbSubMenu.Controls.Add(msoControlButton, 1, , , True)
.Caption = '&Submenu Feui1'
.OnAction = ThisWorkbook.Name & '!Macroname'
.Style = msoButtonIconAndCaption
.FaceId = 71
.State = msoButtonDown
End With
' add menuitem to submenu submenu
With cbSubMenu.Controls.Add(msoControlButton, 1, , , True)
.Caption = '&Submenu Item2'
.OnAction = ThisWorkbook.Name & '!Macroname'
.Style = msoButtonIconAndCaption
.FaceId = 72
.Enabled = False
End With

' add menuitem to menu
With cbMenu.Controls.Add(msoControlButton, 1, , , True)
.Caption = '&Remove this menu'
.OnAction = ThisWorkbook.Name & '!RemoveMenu'
.Style = msoButtonIconAndCaption
.FaceId = 463
.BeginGroup = True
End With

Set cbSubMenu = Nothing
Set cbMenu = Nothing
End Sub

Sub RemoveMenu()
DeleteCustomCommandBarControl 'MyTag' ' deletes the new menu
End Sub

Private Sub DeleteCustomCommandBarControl(CustomControlTag As String)
' deletes ALL occurences of commandbar controls with a tag = CustomControlTag
On Error Resume Next
Do
Application.CommandBars.FindControl(, , CustomControlTag, False).Delete
Loop Until Application.CommandBars.FindControl(, , CustomControlTag, False) Is Nothing
On Error GoTo 0
End Sub

Sub Macroname()
' used by the menuitems created by the CreateMenu macro
MsgBox 'This could be your macro running!', vbInformation, ThisWorkbook.Name
End Sub

trés cordialement
le partage de savoir participe à l'amélioration de la vie hummaine.

Abed_H

Bonsoir à tous,

Raymond Devos, c'était super avec en + du Brassens de derrière les fagots !

pour macpoy un exemple de menu (inscription dans une cellule des thèmes d'un emploi du temps de formation) . TU peux remplacer Range('nbreint') par le nombre d'onglets etRange('opt1') opt2 par leur nom



Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)

'INSERE UN MENU CONTEXTUEL QUI ECRIT UN TEXTE DANS UNE CELLULE

'avec le menu contextuel standard du clic droit ('cell')
With Application.CommandBars('cell')
'ajoute en première ligne (before) un menu contextuel (popup)
With .Controls.Add(msoControlPopup, before:=1)
'intitulé (caption) comme suit
.Caption = 'Intitulés emploi du temps'


'sousmenu du popup 'emploi du temps'
' ajoute un bouton de controle intitulé par la valeur inscrite dans opt1

'ajuste la hauteur du popup au nombre de valeur inscrites
If Range('nbreint') >= 1 Then
.Controls.Add (msoControlButton)
.Controls(1).Caption = Range('opt1')
' avec un clic sur cette option
With .Controls(1)
' déclenche la macro 'choix1' du module 1
.OnAction = 'choix1'
End With
End If

.....

'sousmenu 4
If Range('nbreint') >= 4 Then
.Controls.Add (msoControlButton)
.Controls(4).Caption = Range('opt4')
With .Controls(4)
.OnAction = 'choix4'
End With
End If

End With
End With

End Sub

et un exemple de 'on action' et qui réinitialise le pop-up

Sub choix1()
' affecte à la cellule active la valeur de la cellule 'opt1'
ActiveCell = Range('opt1')
' réinitialise le menu contextuel standard
'(sinon 'intitulé emploi du temps' apparaitra 2 fois au prochain clic droit)
Application.CommandBars('cell').Reset
End Sub

Re;;;
j'ai oublié de dir que l'auteur de ce code c'est

Ole P. Erlandsen merci a lui

Abed_H

Bonsoir Michel, Abed, Dan, José, MacPoy, le Forum

Bon alors en mémoire des Belges qui ne risquent pas de se faire éliminer de ce Mundial....

Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Cancel = True
Application.CommandBars('Workbook tabs').ShowPopup
End Sub

Cliquez pour agrandir...

😉 That's all folk 😉

Par contre Nicht Good le Nouveau Forum, Moteur de Recherche vraiment pas du tout efficace sur ce coup là...

Je vais de ce pas dans le Forum prévu à cet effet.

[ol]@+Thierry[/ol]

EDITION !!!

PS Code à mettre dans le Private Module de ThisWorkBook, pour être opérant sur toutes les Feuilles du Classeurs...

Message édité par: _Thierry, à: 19/06/2006 23:52

bonsoir le forum, bonsoir aux participants de ce fil,
merci beaucoup pour votre coup de patte,
j'ai eue l'occasion de finir et obtenir ce que je souhaitais. voici les codes :
le premier à mettre dans Thisworkbook.


Const Proc9 = 'LesFeuilles'

Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim NbWs, U
Application.CommandBars('Cell').Reset

With Application.CommandBars('Cell').Controls _
.Add(Type:=msoControlComboBox, temporary:=True)
.Caption = 'Feuilles' '(i)
.Tag = 'Toto'
.OnAction = Proc9
For U = 1 To Worksheets.Count
.AddItem Sheets(U).Name
Next

End With

End Sub


le deuxième dans un module.

Sub LesFeuilles()
Dim Mycontrole As CommandBarComboBox
Dim Choix
Dim C, Adr
Set Mycontrole = Application.CommandBars('cell').FindControl _
(Type:=msoControlComboBox, Tag:='Toto')

Choix = Mycontrole.ListIndex
Sheets(Choix).Activate

End Sub

merci à tous.
au plaisir de vous recroiser sur ce site.(ou ailleur!!!)

salut tout le monde

Macpoy, ce .tag='toto' me rappel quelque chose.

ca ne serait pas un code à jmps ?

🙂

salut

Message édité par: hervé, à: 20/06/2006 17:59

Re,
désolé hervé la seule chose dont je me rappel pour ce tag, c'est que c'est un Excellien d'ici qui me l'avait fourni lors d'un de mes précedent problèmes.
je pourrais retrouver, mais est ce bien la peine ?

sur ce, merci encore une fois pour l'aide que vous nous apportez.

re

mac, c'etait de l'humour, avec josé on utilise souvent le patronyme toto dans nos codes.

pour savoir qui etait l'excellien, regarde ici :

Lien supprimé

🙂

salut

Re le forum,
Re Hervé,
désolé d'avoir oublié l'aide que tu m'avais apporté. je suis confus d'avoir si peus de mémoire vis à vis des Excelliens de ce site.

peu tu m'expliquer (simplement!!!) pourquoi, et à quoi sert le tag ?
dans quelles conditions est ce nécessaire ?
il est propable que je dépasse le but de ce forum avec mes question, mais je cherche à comprendre le 'langage' VBA.