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
Bonjour.
Dans une Sub Worksheet_Change, ajoutez toujours une instruction Application.EnableEvents = False avant de modifier des cellules, afin que ça ne provoque pas son appel récursif, et terminez les modifications par une Application.EnableEvents = True.
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Bonjour le fil, pat66

Ceci fonctionne sur mon fichier de test
VB: 
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
shp.Visible = Switch(T = "A", True, T = "D", False)
End If
Next
End If
End Sub
EDITION: Bonjour Dranreb
 
Dernière édition:
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Re

Et cette variante d'écriture aussi
VB: 
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
shp.Visible = (T = "A") + ((T = "D") * 0)
End If
Next
End If
End Sub
 
Vote positif 0 Vote négatif
P

pat66

XLDnaute Impliqué
Bonjour à tous les deux
J'ai essayé avec enableevents rien n'y change, par contre avec celle de Stapple1600, ca à l'air de fonctionner, mais il y a des shapes qui doivent rester affichées quelque soit A ou D dans K82, comme :
Rectangle : coins arrondis 4
Rectangle : coins arrondis 33
Rectangle : coins arrondis 28, etc
comment peut faire pour elles restent affichées

merci Stapple1600
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Re

A la relecture, je me demande si j'ai bien compris la donne
Mon code fait ceci
Si en K82 on a A alors les shapes rectangle arrondi sont visibles
Si en K82 on a D alors les shapes rectangle arrondi sont invisibles.

Est-ce le but recherché?

Combien il y a de shapes en tout?
 
Vote positif 0 Vote négatif
P

pat66

XLDnaute Impliqué
oui c'est bien ca ,
Avec ta macro
Si K82 = D
cela masque aussi les shapes de la feuille qui servent d'intitulés, hors je souhaiterais que les shapes qui servent d'intitulés restent affichées en permanence que ce soit avec A ou D

et lorsque lorsque K82 = A , tout reste affiché y compris Les shapes qui devraient être masquées avec D

La liste qui est concernée par A ou D, est dans mon premier post, les autres shapes ne sont pas concernées
 
Dernière édition:
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Re

Est-ce que c'est mieux ainsi?
VB: 
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
 
Vote positif 0 Vote négatif
P

pat66

XLDnaute Impliqué
c'est impeccable Stapple, avec cette macro, les shapes concernées par A ou D, s'affichent ou se masquent simultanément, mais je souhaiterai masquer ces mêmes shapes à l'ouverture du classeur pour pouvoir les réafficher au fur et à mesure grâce a des bouton shapes déjà programmé

car j'ai beau présisé dans open,
ex : Worksheets("Bilan").Shapes("Rectangle : coins arrondis 28").Visible = False,
etc,
etc

mais lorsque je vais sur la feuille toutes shapes concernées par A ou D sont déjà affichées

aurais tu une solution pour cela ?
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Re

Juste pour info
C'est Staple avec un seul p ;)

Sinon pour ta question, ne connaissant pas la structure de ton classeur ni le reste du code VBA, je teste un peu à l'aveugle.

Pour une aide plus efficace, prends le temps de construire un fichier exemple (allégé, anonymisé et avec uniquement ce qui illustre ta problématique)
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Re

Voir ce que ceci peut donner
(sans doute avec des effets de bord)
Enrichi (BBcode): 
Private Sub Workbook_Open()
Feuil2.DrawingObjects.Visible = False
End Sub
NB: Pour réafficher, mettre sur True.
Et modifier le codename de la feuille (en bleu) selon la feuille concernée.
 
Dernière édition:
Vote positif 0 Vote négatif
P

pat66

XLDnaute Impliqué
Re Staple ';),

c'est impeccable tout fonctionne sauf que " Feuil2.DrawingObjects.Visible = False" masque bien les shapes y compris les boutons shapes , ce qu'il ne faudrait pas, peut on ajouter des exceptions pour les boutons shapes qui doivent rester apparents dans tous les cas ?
 
Vote positif 0 Vote négatif

Discussions similaires

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

Membres actuellement en ligne

12 membres et 161 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
312 209
Messages
2 086 266
Membres
103 168
dernier inscrit
isidore33