XL 2019 Problème avec Worksheet_Change(ByVal Target As Range)

P

pat66

XLDnaute Impliqué
Bonjour le Forum,

j'ai un problème avec cette macro, elles me bloque lorsque j'active la feuille ou que je souhaite sauvegarder le classeur, quelqu'un pourrait il me venir en aide, un grand merci

Private Sub Worksheet_Activate()
Application.ScreenUpdating = False
Worksheets("Bilan").Unprotect ("SC6")
Range("A1:W5").Select
ActiveWindow.Zoom = True
ScrollArea = "A1:W35"
If [J78].Value = "A" Then
Range("K82") = "A"
ActiveSheet.Shapes("Rectangle : coins arrondis 34").Visible = True
ActiveSheet.Shapes("Rectangle : coins arrondis 35").Visible = True
ActiveSheet.Shapes("Rectangle : coins arrondis 36").Visible = True
ActiveSheet.Shapes("Rectangle : coins arrondis 37").Visible = True
ActiveSheet.Shapes("Rectangle : coins arrondis 38").Visible = True
ActiveSheet.Shapes("Rectangle : coins arrondis 46").Visible = True

ActiveSheet.Shapes("Rectangle : coins arrondis 32").Visible = False
ActiveSheet.Shapes("Rectangle : coins arrondis 39").Visible = False
ActiveSheet.Shapes("Rectangle : coins arrondis 40").Visible = False
ActiveSheet.Shapes("Rectangle : coins arrondis 41").Visible = False
ActiveSheet.Shapes("Rectangle : coins arrondis 42").Visible = False
ActiveSheet.Shapes("Rectangle : coins arrondis 45").Visible = False
Else
Range("K82") = "D"
ActiveSheet.Shapes("Rectangle : coins arrondis 34").Visible = False
ActiveSheet.Shapes("Rectangle : coins arrondis 35").Visible = False
ActiveSheet.Shapes("Rectangle : coins arrondis 36").Visible = False
ActiveSheet.Shapes("Rectangle : coins arrondis 37").Visible = False
ActiveSheet.Shapes("Rectangle : coins arrondis 38").Visible = False
ActiveSheet.Shapes("Rectangle : coins arrondis 46").Visible = False

ActiveSheet.Shapes("Rectangle : coins arrondis 32").Visible = True
ActiveSheet.Shapes("Rectangle : coins arrondis 39").Visible = True
ActiveSheet.Shapes("Rectangle : coins arrondis 40").Visible = True
ActiveSheet.Shapes("Rectangle : coins arrondis 41").Visible = True
ActiveSheet.Shapes("Rectangle : coins arrondis 42").Visible = True
ActiveSheet.Shapes("Rectangle : coins arrondis 45").Visible = True
End If
Range("A1").Select
Worksheets("Bilan").Protect ("SC6")
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
If [K82].Value = "A" Then
ActiveSheet.Shapes("Rectangle : coins arrondis 34").Visible = True
ActiveSheet.Shapes("Rectangle : coins arrondis 35").Visible = True
ActiveSheet.Shapes("Rectangle : coins arrondis 36").Visible = True
ActiveSheet.Shapes("Rectangle : coins arrondis 37").Visible = True
ActiveSheet.Shapes("Rectangle : coins arrondis 38").Visible = True
ActiveSheet.Shapes("Rectangle : coins arrondis 46").Visible = True
ActiveSheet.Shapes("Rectangle : coins arrondis 32").Visible = False
ActiveSheet.Shapes("Rectangle : coins arrondis 39").Visible = False
ActiveSheet.Shapes("Rectangle : coins arrondis 40").Visible = False
ActiveSheet.Shapes("Rectangle : coins arrondis 41").Visible = False
ActiveSheet.Shapes("Rectangle : coins arrondis 42").Visible = False
ActiveSheet.Shapes("Rectangle : coins arrondis 45").Visible = False
Else
Range("K82") = "D"
ActiveSheet.Shapes("Rectangle : coins arrondis 34").Visible = False
ActiveSheet.Shapes("Rectangle : coins arrondis 35").Visible = False
ActiveSheet.Shapes("Rectangle : coins arrondis 36").Visible = False
ActiveSheet.Shapes("Rectangle : coins arrondis 37").Visible = False
ActiveSheet.Shapes("Rectangle : coins arrondis 38").Visible = False
ActiveSheet.Shapes("Rectangle : coins arrondis 46").Visible = False
ActiveSheet.Shapes("Rectangle : coins arrondis 32").Visible = True
ActiveSheet.Shapes("Rectangle : coins arrondis 39").Visible = True
ActiveSheet.Shapes("Rectangle : coins arrondis 40").Visible = True
ActiveSheet.Shapes("Rectangle : coins arrondis 41").Visible = True
ActiveSheet.Shapes("Rectangle : coins arrondis 42").Visible = True
ActiveSheet.Shapes("Rectangle : coins arrondis 45").Visible = True
End If

un grand merci et une belle journée amis excelliens
 
Dernière édition:
Solution
Staple1600
Bonsoir le fil

J'ai repris la très bonne idée de laurent950
(Grouper les formes)
Ce qui allège très beaucoup le code ;)
Pré-requis
Je groupe au préalable manuellement les formes
grouper.jpg
J'ai fait deux groupes.
Un premier nommé: Affichees et le second Masquees
Et dans le code de la feuille, j'ai juste ce code VBA.
VB: 
Private Sub Worksheet_Change(ByVal T As Range)
If T.Address = "$B$2" Then
Shapes.Range("Affichees").Visible = (T = "A") + ((T = "D") * 0)
Shapes.Range("Masquees").Visible = ((T = "A") * 0) + (T = "D")
End If
End Sub
Private Sub Worksheet_Deactivate()
Shapes.Range("Affichees").Visible = msoFalse
Shapes.Range("Masquees").Visible = msoFalse
End Sub
Private Sub Worksheet_Activate()
Shapes.Range("Affichees").Visible =...
Trier par date Trier par votes
Dranreb

Dranreb

XLDnaute Barbatruc
Je vous l'ai dit :
Mettez une instruction Application.EnableEvents = False devant et une instruction Application.EnableEvents = True derrière.
Ainsi la modification de la cellule ne provoquera plus la réexécution sans fin de la procédure finissant par aboutir à la saturation de la pile des appels.
 
Vote positif 0 Vote négatif
P

pat66

XLDnaute Impliqué
Re,
mon classeur contient plus de 60 feuilles, je vais essayé de faire une extraction
Mais dans cette macro, on est bien d'accord qu'elle masque ou affiche en même temps certaines shapes selon le contenu de K82.
Je dois préciser que chaque shapes sera visible grâce à un bouton shapes (affichage progressif ou séquentiel), ma question peut on faire en sorte que lorsque j'ouvre le classeur et active la feuille toutes les shapes contenues dans ta macro soient masquées quelque soit le contenu de K82 ?

J'ai pensé à Sub Worksheet_Activate() , mais non car chaque fois il faudra les réafficher ?
Peut personnaliser Feuil2.DrawingObjects.Visible = False" afin de ne masquer que les shapes contenues dans la macro ?

Private Sub Worksheet_Change(ByVal T As Range)
Dim shp As Shape
If Not Intersect(T, [K82]) Is Nothing Then
For Each shp In ActiveSheet.Shapes
If InStr(shp.Name, "Rounded") > 0 Then
Select Case Val(Right(shp.Name, 2))
Case 34 To 38
shp.Visible = (T = "A") + ((T = "D") * 0)
Case 32, 39 To 42, 45
shp.Visible = ((T = "A") * 0) + (T = "D")
End Select
End If
Next
End If
End Sub

un grand merci
 
Dernière édition:
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Re

Je te laisse tester
VB: 
Private Sub Workbook_Open()
Dim shp As Shape, f As Worksheet
Set f = Feuil1
Application.EnableEvents = False
For Each shp In f.Shapes
If InStr(shp.Name, "Rounded") > 0 Then
Select Case Val(Right(shp.Name, 2))
Case 34 To 38
shp.Visible = 0
Case 32, 39 To 42, 45
shp.Visible = 0
End Select
End If
Next
Application.EnableEvents = True
End Sub
NB: je reviendrai vers 22h43, je dois éteindre ma lessive et défaire ma vaisselle sans oublier de laver ma valise.
;)
 
Vote positif 0 Vote négatif
laurent950

laurent950

XLDnaute Barbatruc
Bonsoir @Staple1600, @Dranred

Peux être une astuce.
VB: 
Public shTrue As Shape
Public shFalse As Shape
Private Sub Worksheet_Activate()
On Error Resume Next
    Set shTrue = ActiveSheet.Shapes.Range(TabshTrue).Group
        shTrue.Visible = True
    Set shFalse = ActiveSheet.Shapes.Range(TabshFalse).Group
        shFalse.Visible = False
On Error GoTo 0

Application.ScreenUpdating = False
If [A1].Value = "A" Then
Range("A2") = "A"
shTrue.Visible = True
'
shFalse.Visible = False
Else
Range("A2") = "D"
shTrue.Visible = False
'
shFalse.Visible = True
End If
ActiveWindow.Zoom = False
End Sub

Le code qui créé les Shape

VB: 
Public shTrue(0 To 5) As Shape
Public TabshTrue(0 To 5) As String
Public Ttrue As Variant
Public shFalse(0 To 5) As Shape
Public TabshFalse(0 To 5) As String
Public Tfalse As Variant
Sub test()
    Ttrue = Array(34, 35, 36, 37, 38, 46)
    Tfalse = Array(32, 39, 40, 41, 42, 45)
pos = 25
For i = LBound(Ttrue) To UBound(Ttrue)
If i = LBound(Ttrue) Then pos = 25 Else pos = pos + i + 50
    Set shTrue(i) = Sheets("Feuil1").Shapes.AddShape(msoShapeRoundedRectangle, 25, pos, 121, 36.5)
        shTrue(i).Name = "Rectangle : coins arrondis " & Ttrue(i)
        TabshTrue(i) = CStr(shTrue(i).Name)
        shTrue(i).Visible = True
If i = LBound(Tfalse) Then pos = 25 Else pos = pos
    Set shFalse(i) = Sheets("Feuil1").Shapes.AddShape(msoShapeRoundedRectangle, 225, pos, 121, 36.5)
        shFalse(i).Name = "Rectangle : coins arrondis " & Tfalse(i)
        TabshFalse(i) = CStr(shFalse(i).Name)
        shFalse(i).Visible = True
Next i
End Sub
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Bonsoir laurent950

=>laurent950
Les shapes sont déjà créés manuellement
Et d'où tu tiens ces données?
pos = 25
(vu qu'il n'y a pas de PJ dans le fil ???)

PS: Pour le masquage à l'ouverture, voir message#20

Bon, je retourne à mes corvées ménagères.
 
Dernière édition:
Vote positif 0 Vote négatif
P

pat66

XLDnaute Impliqué
Dranreb à dit:
Je vous l'ai dit :
Mettez une instruction Application.EnableEvents = False devant et une instruction Application.EnableEvents = True derrière.
Ainsi la modification de la cellule ne provoquera plus la réexécution sans fin de la procédure finissant par aboutir à la saturation de la pile des appels.
Cliquez pour agrandir...
Dranreb,

j'ai testé avec Application.EnableEvents = false, mais j'ai des erreurs, excel me dit qu'il ne trouve pas certaines shapes et la macro s'arrête, aurais tu l'amabilité de me dire si je l'ai bien placé ou de me l'écrire dans :

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Application.EnableEvents = false
If [K82].Value = "A" Then
ActiveSheet.Shapes("Rectangle : coins arrondis 34").Visible = True
ActiveSheet.Shapes("Rectangle : coins arrondis 35").Visible = True
ActiveSheet.Shapes("Rectangle : coins arrondis 36").Visible = True
ActiveSheet.Shapes("Rectangle : coins arrondis 37").Visible = True
ActiveSheet.Shapes("Rectangle : coins arrondis 38").Visible = True
ActiveSheet.Shapes("Rectangle : coins arrondis 46").Visible = True
ActiveSheet.Shapes("Rectangle : coins arrondis 32").Visible = False
ActiveSheet.Shapes("Rectangle : coins arrondis 39").Visible = False
ActiveSheet.Shapes("Rectangle : coins arrondis 40").Visible = False
ActiveSheet.Shapes("Rectangle : coins arrondis 41").Visible = False
ActiveSheet.Shapes("Rectangle : coins arrondis 42").Visible = False
ActiveSheet.Shapes("Rectangle : coins arrondis 45").Visible = False
Else
Range("K82") = "D"
ActiveSheet.Shapes("Rectangle : coins arrondis 34").Visible = False
ActiveSheet.Shapes("Rectangle : coins arrondis 35").Visible = False
ActiveSheet.Shapes("Rectangle : coins arrondis 36").Visible = False
ActiveSheet.Shapes("Rectangle : coins arrondis 37").Visible = False
ActiveSheet.Shapes("Rectangle : coins arrondis 38").Visible = False
ActiveSheet.Shapes("Rectangle : coins arrondis 46").Visible = False
ActiveSheet.Shapes("Rectangle : coins arrondis 32").Visible = True
ActiveSheet.Shapes("Rectangle : coins arrondis 39").Visible = True
ActiveSheet.Shapes("Rectangle : coins arrondis 40").Visible = True
ActiveSheet.Shapes("Rectangle : coins arrondis 41").Visible = True
ActiveSheet.Shapes("Rectangle : coins arrondis 42").Visible = True
ActiveSheet.Shapes("Rectangle : coins arrondis 45").Visible = True
Application.EnableEvents = true

End If
 
Vote positif 0 Vote négatif
Dranreb

Dranreb

XLDnaute Barbatruc
Ça ne doit pas être lié mais bon
Il serait préférable d'encadrer juste la modification de la cellule K82 par un "D".
Parce que là, si c'est la 1ère condition qui est vraie, ce n'est pas remis à True à la fin, et il s'en suit que les évènements Excel ne seront plus détectés.
 
Vote positif 0 Vote négatif
P

pat66

XLDnaute Impliqué
Staple1600 à dit:
Re

Je te laisse tester
VB: 
Private Sub Workbook_Open()
Dim shp As Shape, f As Worksheet
Set f = Feuil1
Application.EnableEvents = False
For Each shp In f.Shapes
If InStr(shp.Name, "Rounded") > 0 Then
Select Case Val(Right(shp.Name, 2))
Case 34 To 38
shp.Visible = 0
Case 32, 39 To 42, 45
shp.Visible = 0
End Select
End If
Next
Application.EnableEvents = True
End Sub
NB: je reviendrai vers 22h43, je dois éteindre ma lessive et défaire ma vaisselle sans oublier de laver ma valise.
;)
Cliquez pour agrandir...
Re,
cela ne fonctionne pas les shapes affichées restent affichées à l'ouverture du classeur certaineùent influencé par le Worksheet_Change(ByVal Target As Range)
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Re

Si cela fonctionne
(je viens de tester)
Il faut juste que le codename de la feuille soit le bon dans le code VBA
Enrichi (BBcode): 
Dim shp As Shape, f As Worksheet
Set f = Feuil1'ici mettre le bon codename
'NB: Le codename et pas le nom de la feuille
 
Vote positif 0 Vote négatif
P

pat66

XLDnaute Impliqué
Staple1600 à dit:
Re

Si cela fonctionne
(je viens de tester)
Il faut juste que le codename de la feuille soit le bon dans le code VBA
Enrichi (BBcode): 
Dim shp As Shape, f As Worksheet
Set f = Feuil1'ici mettre le bon codename
'NB: Le codename et pas le nom de la feuille
Cliquez pour agrandir...
re,
effectivement cela fonctionne , c'est que j'ai un Worksheet_Activate() qui interfère, il me sert à inscrire dans K82 pour pour pouvoir afficher les bonnes shapes lorsque je cliques les boutons

' Private Sub Worksheet_Activate()
'Application.ScreenUpdating = False
'Worksheets("Bilan").Unprotect ("SC6")
'Range("A1:W5").Select
'ActiveWindow.Zoom = True
'ScrollArea = "A1:W35"
'If [J78].Value = "A" Then
'Range("K82") = "A"

je vais revoir tout ça et je reviens vers toi

un grand merci,
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Re

Comme précédemment suggéré un fichier exemple serait le bienvenu
Avec juste les shapes référencées dans le code de masquage/démasquage plus deux trois formes non concernées.
Avec le reste du code et les contrôles (CommandButton) qui s'y réfèrent.

Plus tu nous fourniras de quoi t'aider, plus vite et mieux on pourra le faire.
;)

PS:
je vais revoir tout ça et je reviens vers toi
Cliquez pour agrandir...
Je ne suis pas seul sur le forum ;)
Nous sommes plusieurs à répondre aux questions.
;)
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Bonsoir le fil

J'ai repris la très bonne idée de laurent950
(Grouper les formes)
Ce qui allège très beaucoup le code ;)
Pré-requis
Je groupe au préalable manuellement les formes
grouper.jpg
J'ai fait deux groupes.
Un premier nommé: Affichees et le second Masquees
Et dans le code de la feuille, j'ai juste ce code VBA.
VB: 
Private Sub Worksheet_Change(ByVal T As Range)
If T.Address = "$B$2" Then
Shapes.Range("Affichees").Visible = (T = "A") + ((T = "D") * 0)
Shapes.Range("Masquees").Visible = ((T = "A") * 0) + (T = "D")
End If
End Sub
Private Sub Worksheet_Deactivate()
Shapes.Range("Affichees").Visible = msoFalse
Shapes.Range("Masquees").Visible = msoFalse
End Sub
Private Sub Worksheet_Activate()
Shapes.Range("Affichees").Visible = msoFalse
Shapes.Range("Masquees").Visible = msoFalse
End Sub
Test OK sur mon fichier test
(voir ci-dessous)
1: A en B2 le groupe Affichee est visible, l'autre masqué
2: D en B2 le groupe Masquee est visible, l'autre masqué
3: Je suis allé une autre feuille, puis revenu sur la feuille, les 2 groupes sont masqués.
 

Pièces jointes

  • exempleI.gif
    exempleI.gif
    62.4 KB · Affichages: 29
Dernière édition:
Vote positif 0 Vote négatif
Solution

Discussions similaires

P
  • Résolu(e)
Microsoft 365 Cellule avec liste déroulante ou pas, sous condition par macro
Réponses
5
Affichages
485
pat66
P
P
  • Résolu(e)
XL 2019 Worksheet_Change(ByVal Target As Range), 3 alternatives
2
Réponses
18
Affichages
1 K
pat66
P
P
  • Résolu(e)
XL 2019 Améliorer voire accélérer une Macro
Réponses
6
Affichages
508
patricktoulon
patricktoulon
P
  • Résolu(e)
XL 2019 Optimiser une macro
Réponses
12
Affichages
590
pat66
P
P
  • Question
XL 2019 Verrouiller plusieurs cellules avec condition
Réponses
3
Affichages
894
fanch55
fanch55
P
  • Résolu(e)
XL 2019 Conditions dans Worksheet_Change(ByVal Target As Range)
Réponses
4
Affichages
465
pat66
P
D
  • Question
XL 2013 Arrondi des paiements en espèces
Réponses
4
Affichages
354
DaONE
D
T
  • Question
Microsoft 365 Problème affichage multipage dans un tabstrip
Réponses
1
Affichages
476
troki74
T
P
  • Résolu(e)
Microsoft 365 Private Sub Worksheet_Change(ByVal Target As Range)
Réponses
8
Affichages
604
pat66
P
A
  • Résolu(e)
Microsoft 365 Trop de caractères de continuité de ligne
Réponses
9
Affichages
695
TooFatBoy
TooFatBoy

Membres actuellement en ligne

3 membres et 43 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 628
Messages
2 111 337
Membres
111 104
dernier inscrit
JEMADA