Faire apparaitre/disparaitre 1000 formes individuellement

Bonjour,
je suis nouveau dans la programmation VBA, après plusieurs recherches sur la toile sans succès, je fais appel à vos lumières afin de savoir s'il y a une solution plus facile à ma programmation. J'ai créé et renommé environ 1000 formes sur une image et je souhaiterai les faire apparaitre individuellement en fonction de la valeur d'une cellule leur étant associé. En gros, l'image est un plan d'un camping et les formes (cercles) entourent un numéro d'emplacement. je souhaiterai que les numéros d'emplacement soient entourés quand on inscrit le chiffre 1 dans la cellule en face de la cellule du numéro de l'emplacement.
Voilà le code que j'ai commencé a créer :

If [N3] = 1 Then ActiveSheet.Shapes("001").Visible = True
If [N3] = Empty Then ActiveSheet.Shapes("001").Visible = False

If [N4] = 1 Then ActiveSheet.Shapes("002").Visible = True
If [N4] = Empty Then ActiveSheet.Shapes("002").Visible = False

If [N5] = 1 Then ActiveSheet.Shapes("003").Visible = True
If [N5] = Empty Then ActiveSheet.Shapes("003").Visible = False

If [N6] = 1 Then ActiveSheet.Shapes("004").Visible = True
If [N6] = Empty Then ActiveSheet.Shapes("004").Visible = False

If [N7] = 1 Then ActiveSheet.Shapes("006").Visible = True
If [N7] = Empty Then ActiveSheet.Shapes("006").Visible = False

If [N8] = 1 Then ActiveSheet.Shapes("007").Visible = True
If [N8] = Empty Then ActiveSheet.Shapes("007").Visible = False
......
Cela fonctionne bien mais je me demandais s'il y avait une solution pour m'éviter de recréer le code 1000 fois pour chaque formes. J'ai plusieurs idées en tête mais je ne sais pas si cela est réalisable.
Merci d'avance pour votre aide.

Bonsoir Kulte30,

Voilà,

Private Sub Worksheet_Change(ByVal Target As Range)
'Cible = Colonne N et Num = 1 à 999
If Target.Column = 14 And Target.Row > 2 And Target.Row < 1000 Then
'Numéro de forme ciblée
Num = Right("000" & Target.Row - 2, 3)
ActiveSheet.Shapes(Num).Visible = Target.Value
End If
End Sub

Mettre ce code dans la partie code de la feuille et non dans un module. Faire ALT + F11 pour ouvrir l'éditeur VBA

Faire clic droit sur le nom de la feuille ou sont les formes. Et insérer ces lignes de code.

Bonsoir,

X Cellus bonsoir,

ci joint un fichier "différent" car j'ai du mal avec le fait qu'il faille 1000 lignes pour gérer ces 1000 shapes !

Je suis donc parti du principe d'une cellule A4 pour indiquer quel emplacement on veut afficher avec une routine événementielle sur le "Change" avec un peu de test de validité de valeur, une routine pour tout masquer, une autre pour tout afficher, une troisième pour renuméroter les shapes et une dernière pour la gestion du bouton "Affiche/Masque tout !"

Le fichier :

@ bientôt

LouReeD

Merci pour la réponse je pense que je n'ai pas dû faire la bonne mise en forme pour que le code fonctionne. Je n'ai pas précisé mais j'ai aussi des numéros d'emplacements avec des lettres en plus des chiffres .Je vous joints le fichier Excel de là où j'en suis sachant que je n'ai pas encore dessiné ou renommé toutes les formes.

A nouveau,

Mais vers 20h j'ai faim. Donc je fais au plus vite avec ce que l'on propose. Peut être que le camping est sur une base de données en ligne avec d'autres infos. Dans des colonnes adjacentes.

Mais que les formes, elles sont placées différemments dans une partie de la feuille.

Enfin, j'espère que c'est le cas.

bonsoir le fil

Sub Emplacements()
     Dim aA, shp
     t = Timer
     With Sheets("plan")
          aA = Sheets("plan").Range("M3:T105").Value2
          On Error Resume Next
          For i = 1 To UBound(aA)
               For j = 1 To UBound(aA, 2) Step 2
                    If Len(aA(i, j)) > 0 Then
                         Set shp = Nothing: Set shp = .Shapes(aA(i, j))
                         If shp Is Nothing Then
                              s = s & ", " & aA(i, j)
                         Else
                              shp.Visible = (aA(i, j + 1) = 1)
                         End If
                    End If
               Next
          Next
     End With
DoEvents
     'MsgBox Timer - t
     If s <> "" Then MsgBox "problème avec les shapes " & vbLf & Mid(s, 3)

End Sub

Bonsoir,

BsAlv bonsoir,

je reste sur l'idée que 1000 lignes sur deux colonnes c'est trop !
Ci joint le fichier modifié dans ce sens, avec deux cellules : la première pour désigner l'emplacement, alors la deuxième cellule se met à la valeur de son état : 0 invisible, 1 visible. Si la valeur de l'état est modifié alors en fonction le shape s'affiche ou pas. Il y a quelque tests de validité, on peut certainement faire mieux aussi, mais c'est pour montrer le principe.

Le fichier :

@ bientôt

LouReeD

@LouReed,

je n'ai pas la même opinion concernant la facilité d'utilisation, mais j'ai modifié votre macro un petit peu, mieux ou pas ?

Private Sub Worksheet_Change(ByVal Target As Range)
     Dim Shp

     Set c = Intersect(Target, Range("G2:H2"))
     If c Is Nothing Then Exit Sub
     If Range("G2").Value = "" Then Exit Sub

     On Error Resume Next
     Set Shp = Me.Shapes(Range("G2").Value)
     If Shp Is Nothing Then MsgBox "faux shape", vbCritical: Exit Sub
     On Error GoTo 0

     Application.EnableEvents = False
     Select Case c.Address
          Case "$G$2"
               Application.EnableEvents = False
               Range("H2").Value = IIf(Shp.Visible, 1, 0)
               Application.EnableEvents = True

          Case "$H$2": Shp.Visible = (Range("H2").Value = 1)
     End Select

End Sub

Pourtant ne serait ce qu'avec le fichier exemple il faut scroller vers le bas et ainsi perdre de vu le camping et la tous les emplacements ne sont pas encore pris en charge. Pour moi les deux cellules (ou un système similaire) me semble plus ergonomique. Mais ceci n'est qu'une affaire de goût !

Pour le code, pourquoi pas, mais je pense qu'il y a un "enableevents = false" de trop, le premier non ?

@ bientôt

LouReeD

Bonjour et Merci pour vos contributions,
la solution de @BsAlv me convient parfaitement car j'ai besoin de sélectionner plusieurs emplacements en même temps. De plus en ayant le numéros d'emplacements dans plusieurs colonnes cela me permet de supprimer facilement la valeur de la cellule pour effacer toutes les formes sur le plan.
@LouReed, je comprend tout à fait ton soucis d'ergonomie. Alors je n'ai pas fait attention si avec ton code on pouvait sélectionner plusieurs emplacements en même temps. Dans une optique d'ergonomie, je m'étais demandé, s'il serait possible seulement en cliquant sur le numéro d'emplacement de faire apparaitre/disparaitre la forme correspondante mais je ne vois pas comment cela pourrait se faire.
En tout cas merci à vous.

bonjour,

Ajoutez ceci dans le module de "Plan"

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
     Set c = Intersect(Target, Range("M3:T105"))     'on a fait un double-click dans cette plage ?
     If c Is Nothing Then Exit Sub     'si non = exit
     Cancel = True     'no popup-window
     With c.Offset(, c.Column Mod 2)     'si le numéro de la colonne est impair (colonne M, O, Q, S), alors une colonne vers droite
          .Value = IIf(.Value = 1, 0, 1)     'flipflop de la valeur de la cellule, si c'était 1, alors maintenant 0 et vice versa.
     End With
End Sub

Si le msgbox vous embête trop, mettez un charactère ' en face, mais regardez pourquoi ces cellules causent des problèmes. Si la forme "314" n'existe pas par exemple, et alors effacez la cellule correspondante S16.

Maintenant la plage est M3:T105 = 100 lignes * 8 colonnes, peut-être c'est mieux d'utiliser 50 lignes * 16 colonnes pour des raisons de la facilité d'utilisation,

Bonjour,

Un USF "toujours visible" avec les 1000 boutons : bouton allumé =cercle visible, bouton éteint = cercle invisible. Un seul bouton par emplacement c'est juste la représentation de ce dernier qui montre l'état du cercle.

Une proposition ce soir peut-être...

Sinon "ma technique" permet d'allumer plusieurs emplacements, il suffit en G2 de mettre leur numéro puis en H2 de mettre 1, et de recommencer...

@BsAlv : "Maintenant la plage est M3:T105 = 100 lignes * 8 colonnes, peut-être c'est mieux d'utiliser 50 lignes * 16 colonnes pour des raisons de la facilité d'utilisation," Comme quoi ce que je disais... Mais comme dit plus haut c'est une histoire "personnel" ce qui est ergonomique pour l'un ne le sera pas pour l'autre ! Moi je suis réfractaire aux raccourcis claviers, je fais tout avec la souris et le clic droit ! Mais les touches je commence à m'y mettre...

@ bientôt

LouReeD

Bonsoir,

voir le fichier :

un USF qui se crée en fonction du nom des emplacements, ce USF est scrollable afin de ne pas prendre trop de place sur l'écran, la feuille reste accessible.
Emplacement "vert" c'est que le rond est visible, emplacement rouge c'est que le rond est invisible.

L'avantage c'est que vous pouvez agrandir l'image de votre camping, et le scroll est limité sur le USF, et avec des boutons plus petits il pourrait prendre moins de place, voir si vous avez deux écrans, la liste des emplacements pourrait être entièrement accessible !

@ bientôt

LouReeD

@LouReed, avec ce Class module et ces labels dans cet userform

Merci BsAlv ! Venant de vous ça me fait plaisir !

J'ai pu l'essayer avec deux écrans : c'est le top ! Avec 2 écrans tout est top et "tant pis" pour la modération énergétique !

Reste à voir si cette ergonomie peut satisfaire kulte30 !

@ bientôt

LouReeD

Je n'ai qu'un écran, donc sur ce point, je ne peux rien dire.

J'étais un petit peu bête, cela se passe en effacant une forme aleatoire et la macro bloque, il n' a pas de traitement d'erreur en cas qu'une forme n'existe plus. Je pensais en lancent cette macro pour les labels de l'userform, mais non. Toute petite défault. Peut-etre après fermeture et réouvrir que cela serait resolu. Ce n'est pas une situation réelle ...

Bonsoir,

évidemment c'est un fichier fourni tel quel, essentiellement pour le principe "final". Il est évident que si c'est cette solution qui est choisie il faudra mettre des garde fous afin de gérer les éventuelles erreurs de l'utilisateurs avec création des shapes inexistants par exemple ou simplement dû à la modification d'un numéro suite au dédoublage d'un emplacement !

@ bientôt

LouReeD

Bonsoir,
Encore merci pour votre aide.
@LouReed au final les deux options sont intéressant notamment la dernière. Je me demandais s'il aurait une option pour faire un reset pour effacer tous les emplacements sélectionnés précédemment d'un coup.
@BsAlv je n'ai pas réussi à faire fonctionner votre code pour le double clic. J'ai aussi déplacé les colonnes pour les rapprocher du plan. J'ai tenter de renseigner les nouvelles cellules cible dans votre code mais je dois avoir fais une erreur car cela ne fonctionne pas pour tous les emplacements.
Je vous mets en copie vos projets avec toutes les formes et tous les emplacements référencés.
Merci

Bonsoir

votre fichier en retour :

Mais si l'on part sur ce principe il faudra ajuster le code... Il y a un bug d'affichage du USF : un label ou plus se retrouvent en haut à gauche du USF...
Mais voyez pour le principe.

@ bientôt

LouReeD

ma mise à jour de mon fichier

* toutes les formes sont groupées de manière, si on modifie les dimensions du group, ca change le rest aussi.

* le Zoom est au niveau qu'on voit le plan et tous les chiffres

* quand on selectionne un ou plusieurs cellules (on peut utiliser les touches SHIFT et CTRL) et puis on clicque droite, en fonction de la première cellule (à gauche en haut), le reste de la selection se colorie en vert ou ne pas. Si on veut faire autre chose avec ce clicque droit il faut utiliser les macros E_ON et E_OFF.

je dépasse 1.5 MB donc le fichier est un problème ... (pour cet après-midi)