Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

excel 2002 : Menu contextuel dans macros

3 réponses
Avatar
crahay
Lorsque j'enregistre une macro permettant de cr=E9er une=20
nouvelle barre, celle-ci faisant appel =E0 des sous menus=20
(menu contextuel personnalis=E9 ou custom popup), la macro=20
se plante d=E8s qu'elle veut cr=E9er ce sous menu (run time=20
error 5.

Exemple ci-dessous.

Merci d'avance

Sub Macro1()
'
' Macro1 Macro

Application.CommandBars.Add(Name:=3D"Custom 1").Visible=20
=3D True
Application.CommandBars("Custom 1").Controls.Add=20
Type:=3DmsoControlPopup, _
Before:=3D1
Application.CommandBars("Custom Popup=20
90768640").Controls.Add Type:=3D _
msoControlPopup, Before:=3D1
Application.CommandBars("Custom Popup=20
90771578").Controls.Add Type:=3D _
msoControlPopup, Before:=3D1
End Sub

3 réponses

Avatar
mousnynao
Bonjour,

Voici un exemple de création de menu :

Public Function AjoutBarreMenu() As Boolean
'
Dim Texte As String
Dim i As Integer
Dim Flag As Boolean
Dim BarreMenu, MaBarre, Barre, MonItem As Object

On Error GoTo Err_Barre

Flag = False
'Fermeture

'Vérification de la présence du menu
For Each Barre In
Application.CommandBars.ActiveMenuBar.Controls
If (Barre.Caption = "Extraction") Then
Flag = True
Exit For
End If
Next

If (Flag = False) Then
'Création de la barre de menu
Set BarreMenu =
Application.CommandBars.ActiveMenuBar
Set MaBarre = BarreMenu.Controls.Add
(Type:=msoControlPopup, temporary:=True)

MaBarre.Caption = "Extraction"

'Insère menu
Set MonItem = MaBarre.Controls.Add
(Type:=msoControlButton)
With MonItem
.Caption = "Extraire"
.OnAction = "Alignement"
.FaceId = msoButtonCaption
End With

AjoutBarreMenu = True

End If

Exit_Barre:
Exit Function

Err_Barre:
AjoutBarreMenu = False
Texte = "Erreur dans la routine AjoutBarreMenu"
Texte = Texte & Chr(13) & Err.Number
Texte = Texte & Chr(13) & Err.Description
MsgBox Texte
Resume Next

End Function

mousnynao!

-----Message d'origine-----
Lorsque j'enregistre une macro permettant de créer une
nouvelle barre, celle-ci faisant appel à des sous menus
(menu contextuel personnalisé ou custom popup), la macro
se plante dès qu'elle veut créer ce sous menu (run time
error 5.

Exemple ci-dessous.

Merci d'avance

Sub Macro1()
'
' Macro1 Macro

Application.CommandBars.Add(Name:="Custom 1").Visible
= True
Application.CommandBars("Custom 1").Controls.Add
Type:=msoControlPopup, _
Before:=1
Application.CommandBars("Custom Popup
90768640").Controls.Add Type:= _
msoControlPopup, Before:=1
Application.CommandBars("Custom Popup
90771578").Controls.Add Type:= _
msoControlPopup, Before:=1
End Sub

.



Avatar
Bonjour Mousnynao,

Un grand merci d'avoir répondu.

Le problème n'est pas résolu pour autant, car ce n'est
qu'au deuxième niveau de sous menus que le problème
apparait. Et mon programme tourne correctement sur excel
2000 et pas sur excel 2002.

Comment expliquer cela si ce n'est un bug dans la version
2002 ? Y aurait-il moyen de contourner ce problème ?

Merci beaucoup et à bientôt, André
-----Message d'origine-----
Bonjour,

Voici un exemple de création de menu :

Public Function AjoutBarreMenu() As Boolean
'
Dim Texte As String
Dim i As Integer
Dim Flag As Boolean
Dim BarreMenu, MaBarre, Barre, MonItem As Object

On Error GoTo Err_Barre

Flag = False
'Fermeture

'Vérification de la présence du menu
For Each Barre In
Application.CommandBars.ActiveMenuBar.Controls
If (Barre.Caption = "Extraction") Then
Flag = True
Exit For
End If
Next

If (Flag = False) Then
'Création de la barre de menu
Set BarreMenu =
Application.CommandBars.ActiveMenuBar
Set MaBarre = BarreMenu.Controls.Add
(Type:=msoControlPopup, temporary:=True)

MaBarre.Caption = "Extraction"

'Insère menu
Set MonItem = MaBarre.Controls.Add
(Type:=msoControlButton)
With MonItem
.Caption = "Extraire"
.OnAction = "Alignement"
.FaceId = msoButtonCaption
End With

AjoutBarreMenu = True

End If

Exit_Barre:
Exit Function

Err_Barre:
AjoutBarreMenu = False
Texte = "Erreur dans la routine AjoutBarreMenu"
Texte = Texte & Chr(13) & Err.Number
Texte = Texte & Chr(13) & Err.Description
MsgBox Texte
Resume Next

End Function

mousnynao!

-----Message d'origine-----
Lorsque j'enregistre une macro permettant de créer une
nouvelle barre, celle-ci faisant appel à des sous menus
(menu contextuel personnalisé ou custom popup), la macro
se plante dès qu'elle veut créer ce sous menu (run time
error 5.

Exemple ci-dessous.

Merci d'avance

Sub Macro1()
'
' Macro1 Macro

Application.CommandBars.Add(Name:="Custom
1").Visible


= True
Application.CommandBars("Custom 1").Controls.Add
Type:=msoControlPopup, _
Before:=1
Application.CommandBars("Custom Popup
90768640").Controls.Add Type:= _
msoControlPopup, Before:=1
Application.CommandBars("Custom Popup
90771578").Controls.Add Type:= _
msoControlPopup, Before:=1
End Sub

.

.





Avatar
Frédéric Sigonneau
Bonjour,

Ta macro plante, dans un premier temps, parce que CommandBars("Custom Popup
90768640") n'existe pas quand tu l'appelles (à ce moment là seule
CommandBars("Custom 1") a été créée. Il faut détailler toutes les opérations
pour que ça fonctionne :

Sub Macro1()
Application.CommandBars.Add(Name:="Custom 1").Visible = True
Application.CommandBars("Custom 1").Controls. _
Add(Type:=msoControlPopup, Before:=1).Caption = "Custom Popup 90768640"
Application.CommandBars("Custom 1").Controls("Custom Popup 90768640"). _
Controls. _
Add(Type:=msoControlPopup, Before:=1).Caption = "Custom Popup 90771578"
End Sub

FS
--
Frédéric Sigonneau [MVP Excel - né un sans-culottide]
Gestions de temps, VBA pour Excel :
http://perso.wanadoo.fr/frederic.sigonneau
Si votre question sur Excel est urgente, évitez ma bal !


Lorsque j'enregistre une macro permettant de créer une
nouvelle barre, celle-ci faisant appel à des sous menus
(menu contextuel personnalisé ou custom popup), la macro
se plante dès qu'elle veut créer ce sous menu (run time
error 5.

Exemple ci-dessous.

Merci d'avance

Sub Macro1()
'
' Macro1 Macro

Application.CommandBars.Add(Name:="Custom 1").Visible
= True
Application.CommandBars("Custom 1").Controls.Add
Type:=msoControlPopup, _
Before:=1
Application.CommandBars("Custom Popup
90768640").Controls.Add Type:= _
msoControlPopup, Before:=1
Application.CommandBars("Custom Popup
90771578").Controls.Add Type:= _
msoControlPopup, Before:=1
End Sub