Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel Bug sur le menu contextuel

Bug sur le menu contextuel

3 réponses
Avatar
dan---
Bonjour,

Voila j'ai crée un menu sur le clic droit qui s'active
selon la position de la cellule dans la feuille....
Cela fonctionnait bien puis d'un seul coup,
le menu contextuel ne s'active plus sur la feuille mais
sur les autres feuilles

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Application.ScreenUpdating = False
'zone interdite avec le clic droit
Set CellChange = Range("A1:B1000, A1:AZ13")
On Error Resume Next
If Not Application.Intersect(CellChange, Range(Target.Address)) _
Is Nothing Then
Application.CommandBars("cell").Enabled = False
End If
' plage des postes
Set CellChange = Range("C14:J1000,L14:L1000,N14:AC1000")
' On Error Resume Next
If Not Application.Intersect(CellChange, Range(Target.Address)) _
Is Nothing Then
Clic_droit_Plage_postes
End If
'Plage des tolérances
Set CellChange = Range("K16:K1000,M16:M1000")
On Error Resume Next
If Not Application.Intersect(CellChange, Range(Target.Address)) _
Is Nothing Then
Clic_droit_Plage_estim_Etat_Qte
End If
End Sub
_______________

Sub Clic_droit_Plage_estim_Etat_Qte()

Application.CommandBars("Cell").Reset
For Each Controle In Application.CommandBars("Cell").Controls
Controle.Visible = False
Next Controle

'valeurs des captions
Tolérance1 = Range("AA2").Value
Tolérance2 = Range("AA3").Value
Tolérance3 = Range("AA4").Value
Tolérance4 = Range("AA5").Value
Tolérance5 = Range("AA6").Value
With Application.CommandBars("Cell").Controls.Add(msoControlButton)
.Caption = Tolérance1
.BeginGroup = True
.OnAction = "Tolér_1"
.FaceId = 1392
End With

With Application.CommandBars("Cell").Controls.Add(msoControlButton)
.Caption = Tolérance2
.BeginGroup = True
.OnAction = "Tolér_2"
.FaceId = 1393
End With

With Application.CommandBars("Cell").Controls.Add(msoControlButton)
.Caption = Tolérance3
.BeginGroup = True
.OnAction = "Tolér_3"
.FaceId = 1394
End With

With Application.CommandBars("Cell").Controls.Add(msoControlButton)
.Caption = Tolérance4
.BeginGroup = True
.OnAction = "Tolér_4"
.FaceId = 1395
End With

With Application.CommandBars("Cell").Controls.Add(msoControlButton)
.Caption = Tolérance5
.BeginGroup = True
.OnAction = "Tolér_5"
.FaceId = 1396
End With
End Sub

Je ne trouve pas la raison de ce bug

Si quelqu'un a une idée, merci d'avance

Daniel
Signaler un problème avec ce contenu

3 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
tissot.emmanuel
Bonjour,

Il faut réactiver le menu contextuel, l'instruction Reset ne fait que le
remettre à son état original.
Application.CommandBars("Cell").Enabled = True
A ajouter dans ta procédure Clic_droit_Plage_estim_Etat_Qte.

Remarque 1: La gestion du menu contextuel devrait prendre place logiquement
dans la procédure
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As
Boolean)

Remarque 2:
Application.Intersect(CellChange, Range(Target.Address))
peut s'écrire:
Intersect(CellChange, Target)

Cordialement,

Manu/

"dan---" a écrit dans le message de news:
463edff9$0$5109$
Bonjour,

Voila j'ai crée un menu sur le clic droit qui s'active
selon la position de la cellule dans la feuille....
Cela fonctionnait bien puis d'un seul coup,
le menu contextuel ne s'active plus sur la feuille mais
sur les autres feuilles

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Application.ScreenUpdating = False
'zone interdite avec le clic droit
Set CellChange = Range("A1:B1000, A1:AZ13")
On Error Resume Next
If Not Application.Intersect(CellChange, Range(Target.Address)) _
Is Nothing Then
Application.CommandBars("cell").Enabled = False
End If
' plage des postes
Set CellChange = Range("C14:J1000,L14:L1000,N14:AC1000")
' On Error Resume Next
If Not Application.Intersect(CellChange, Range(Target.Address)) _
Is Nothing Then
Clic_droit_Plage_postes
End If
'Plage des tolérances
Set CellChange = Range("K16:K1000,M16:M1000")
On Error Resume Next
If Not Application.Intersect(CellChange, Range(Target.Address)) _
Is Nothing Then
Clic_droit_Plage_estim_Etat_Qte
End If
End Sub
_______________

Sub Clic_droit_Plage_estim_Etat_Qte()

Application.CommandBars("Cell").Reset
For Each Controle In Application.CommandBars("Cell").Controls
Controle.Visible = False
Next Controle

'valeurs des captions
Tolérance1 = Range("AA2").Value
Tolérance2 = Range("AA3").Value
Tolérance3 = Range("AA4").Value
Tolérance4 = Range("AA5").Value
Tolérance5 = Range("AA6").Value
With Application.CommandBars("Cell").Controls.Add(msoControlButton)
.Caption = Tolérance1
.BeginGroup = True
.OnAction = "Tolér_1"
.FaceId = 1392
End With

With Application.CommandBars("Cell").Controls.Add(msoControlButton)
.Caption = Tolérance2
.BeginGroup = True
.OnAction = "Tolér_2"
.FaceId = 1393
End With

With Application.CommandBars("Cell").Controls.Add(msoControlButton)
.Caption = Tolérance3
.BeginGroup = True
.OnAction = "Tolér_3"
.FaceId = 1394
End With

With Application.CommandBars("Cell").Controls.Add(msoControlButton)
.Caption = Tolérance4
.BeginGroup = True
.OnAction = "Tolér_4"
.FaceId = 1395
End With

With Application.CommandBars("Cell").Controls.Add(msoControlButton)
.Caption = Tolérance5
.BeginGroup = True
.OnAction = "Tolér_5"
.FaceId = 1396
End With
End Sub

Je ne trouve pas la raison de ce bug

Si quelqu'un a une idée, merci d'avance

Daniel



Avatar
dan---
Merci Manu,

Mais le problème est au niveau de l'affichage de ce menu
contextuel dans la feuille.

Le menu contextuel fonctionne avec les autres feuilles du classeur
et non dans la feuille ou le clic est activé ???

J'ai raccourci les lignes suivant la syntaxe que tu m'as donnée....

Mais là je comprends pas

Daniel

"tissot.emmanuel" a écrit dans le message de news:
OB$
Bonjour,

Il faut réactiver le menu contextuel, l'instruction Reset ne fait que le
remettre à son état original.
Application.CommandBars("Cell").Enabled = True
A ajouter dans ta procédure Clic_droit_Plage_estim_Etat_Qte.

Remarque 1: La gestion du menu contextuel devrait prendre place
logiquement dans la procédure
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As
Boolean)

Remarque 2:
Application.Intersect(CellChange, Range(Target.Address))
peut s'écrire:
Intersect(CellChange, Target)

Cordialement,

Manu/

"dan---" a écrit dans le message de news:
463edff9$0$5109$
Bonjour,

Voila j'ai crée un menu sur le clic droit qui s'active
selon la position de la cellule dans la feuille....
Cela fonctionnait bien puis d'un seul coup,
le menu contextuel ne s'active plus sur la feuille mais
sur les autres feuilles

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Application.ScreenUpdating = False
'zone interdite avec le clic droit
Set CellChange = Range("A1:B1000, A1:AZ13")
On Error Resume Next
If Not Application.Intersect(CellChange, Range(Target.Address)) _
Is Nothing Then
Application.CommandBars("cell").Enabled = False
End If
' plage des postes
Set CellChange = Range("C14:J1000,L14:L1000,N14:AC1000")
' On Error Resume Next
If Not Application.Intersect(CellChange, Range(Target.Address)) _
Is Nothing Then
Clic_droit_Plage_postes
End If
'Plage des tolérances
Set CellChange = Range("K16:K1000,M16:M1000")
On Error Resume Next
If Not Application.Intersect(CellChange, Range(Target.Address)) _
Is Nothing Then
Clic_droit_Plage_estim_Etat_Qte
End If
End Sub
_______________

Sub Clic_droit_Plage_estim_Etat_Qte()

Application.CommandBars("Cell").Reset
For Each Controle In Application.CommandBars("Cell").Controls
Controle.Visible = False
Next Controle

'valeurs des captions
Tolérance1 = Range("AA2").Value
Tolérance2 = Range("AA3").Value
Tolérance3 = Range("AA4").Value
Tolérance4 = Range("AA5").Value
Tolérance5 = Range("AA6").Value
With Application.CommandBars("Cell").Controls.Add(msoControlButton)
.Caption = Tolérance1
.BeginGroup = True
.OnAction = "Tolér_1"
.FaceId = 1392
End With

With Application.CommandBars("Cell").Controls.Add(msoControlButton)
.Caption = Tolérance2
.BeginGroup = True
.OnAction = "Tolér_2"
.FaceId = 1393
End With

With Application.CommandBars("Cell").Controls.Add(msoControlButton)
.Caption = Tolérance3
.BeginGroup = True
.OnAction = "Tolér_3"
.FaceId = 1394
End With

With Application.CommandBars("Cell").Controls.Add(msoControlButton)
.Caption = Tolérance4
.BeginGroup = True
.OnAction = "Tolér_4"
.FaceId = 1395
End With

With Application.CommandBars("Cell").Controls.Add(msoControlButton)
.Caption = Tolérance5
.BeginGroup = True
.OnAction = "Tolér_5"
.FaceId = 1396
End With
End Sub

Je ne trouve pas la raison de ce bug

Si quelqu'un a une idée, merci d'avance

Daniel







Avatar
tissot.emmanuel
Bonjour,

Si j'ai bien compris:

Zone1 = Aucun menu ne doit s'afficher
Zone2 = Affichage du menu standard
Zone3 = Affichage menu personnalisé
Autres feuilles = Affichage du menu standard

Essaye ceci:

Private Sub Worksheet_Deactivate()
'Restauration du menu standard en quittant la feuille
Application.CommandBars("Cell").Reset
End Sub

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As
Boolean)
Application.CommandBars("Cell").Reset 'Pour partir sur de bonnes bases
If Not Intersect(Range("A1:B1000, A1:AZ13"), Target) Is Nothing Then
Cancel = True 'Aucun menu contextuel dans cette zone
Else
If Not Intersect(Range("C14:J1000,L14:L1000,N14:AC1000"), Target) Is
Nothing Then
Clic_droit_Plage_postes 'Execute cette procedure puis affiche
menu contextuel standard
Else
If Not Intersect(Range("K16:K1000,M16:M1000"), Target) Is
Nothing Then
Clic_droit_Plage_estim_Etat_Qte 'Menu personnalisé dans
cette zone
End If
End If
End If
End Sub

Sub Clic_droit_Plage_estim_Etat_Qte()
Dim c As Integer, ct As CommandBarControl
With Application.CommandBars("Cell")
For Each ct In .Controls
ct.Visible = False
Next
For c = 1 To 5
With .Controls.Add(msoControlButton)
.Caption = Range("AA2").Offset(c - 1, 0).Value
.BeginGroup = True
.OnAction = "Tolér_" & c
.FaceId = 1391 + c
End With
Next
End With
End Sub


Reste à gérer le cas ou la sélection fait partie de deux zones
diffférentes...

Tiens nous au courant,

Manu/


"dan---" a écrit dans le message de news:
463f00a9$0$25946$
Merci Manu,

Mais le problème est au niveau de l'affichage de ce menu
contextuel dans la feuille.

Le menu contextuel fonctionne avec les autres feuilles du classeur
et non dans la feuille ou le clic est activé ???

J'ai raccourci les lignes suivant la syntaxe que tu m'as donnée....

Mais là je comprends pas

Daniel

"tissot.emmanuel" a écrit dans le message de
news: OB$
Bonjour,

Il faut réactiver le menu contextuel, l'instruction Reset ne fait que le
remettre à son état original.
Application.CommandBars("Cell").Enabled = True
A ajouter dans ta procédure Clic_droit_Plage_estim_Etat_Qte.

Remarque 1: La gestion du menu contextuel devrait prendre place
logiquement dans la procédure
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As
Boolean)

Remarque 2:
Application.Intersect(CellChange, Range(Target.Address))
peut s'écrire:
Intersect(CellChange, Target)

Cordialement,

Manu/

"dan---" a écrit dans le message de news:
463edff9$0$5109$
Bonjour,

Voila j'ai crée un menu sur le clic droit qui s'active
selon la position de la cellule dans la feuille....
Cela fonctionnait bien puis d'un seul coup,
le menu contextuel ne s'active plus sur la feuille mais
sur les autres feuilles

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Application.ScreenUpdating = False
'zone interdite avec le clic droit
Set CellChange = Range("A1:B1000, A1:AZ13")
On Error Resume Next
If Not Application.Intersect(CellChange, Range(Target.Address)) _
Is Nothing Then
Application.CommandBars("cell").Enabled = False
End If
' plage des postes
Set CellChange = Range("C14:J1000,L14:L1000,N14:AC1000")
' On Error Resume Next
If Not Application.Intersect(CellChange, Range(Target.Address)) _
Is Nothing Then
Clic_droit_Plage_postes
End If
'Plage des tolérances
Set CellChange = Range("K16:K1000,M16:M1000")
On Error Resume Next
If Not Application.Intersect(CellChange, Range(Target.Address)) _
Is Nothing Then
Clic_droit_Plage_estim_Etat_Qte
End If
End Sub
_______________

Sub Clic_droit_Plage_estim_Etat_Qte()

Application.CommandBars("Cell").Reset
For Each Controle In Application.CommandBars("Cell").Controls
Controle.Visible = False
Next Controle

'valeurs des captions
Tolérance1 = Range("AA2").Value
Tolérance2 = Range("AA3").Value
Tolérance3 = Range("AA4").Value
Tolérance4 = Range("AA5").Value
Tolérance5 = Range("AA6").Value
With Application.CommandBars("Cell").Controls.Add(msoControlButton)
.Caption = Tolérance1
.BeginGroup = True
.OnAction = "Tolér_1"
.FaceId = 1392
End With

With Application.CommandBars("Cell").Controls.Add(msoControlButton)
.Caption = Tolérance2
.BeginGroup = True
.OnAction = "Tolér_2"
.FaceId = 1393
End With

With Application.CommandBars("Cell").Controls.Add(msoControlButton)
.Caption = Tolérance3
.BeginGroup = True
.OnAction = "Tolér_3"
.FaceId = 1394
End With

With Application.CommandBars("Cell").Controls.Add(msoControlButton)
.Caption = Tolérance4
.BeginGroup = True
.OnAction = "Tolér_4"
.FaceId = 1395
End With

With Application.CommandBars("Cell").Controls.Add(msoControlButton)
.Caption = Tolérance5
.BeginGroup = True
.OnAction = "Tolér_5"
.FaceId = 1396
End With
End Sub

Je ne trouve pas la raison de ce bug

Si quelqu'un a une idée, merci d'avance

Daniel