excel 2002 : Menu contextuel dans macros

Le
crahay
Lorsque j'enregistre une macro permettant de crer une
nouvelle barre, celle-ci faisant appel des sous menus
(menu contextuel personnalis ou custom popup), la macro
se plante ds qu'elle veut crer 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
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
mousnynao
Le #354039
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

.



Le #354519
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

.

.





Frédéric Sigonneau
Le #355016
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


Publicité
Poster une réponse
Anonyme