Bug sur le menu contextuel

Le
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
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
tissot.emmanuel
Le #4495241
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---" 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



dan---
Le #4495211
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" 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---" 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







tissot.emmanuel
Le #4495111
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---" 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" 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---" 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











Publicité
Poster une réponse
Anonyme