Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Microsoft 365 Afficher /Masquer Shapes selon leurs valeurs

P

pat66

XLDnaute Impliqué
Bonjour le forum,

j'ai un problème et toute aide serait la bienvenue, à savoir : Ne voir que les shapes dont les valeurs sont comprises entre 2 autres valeurs saisies en E6 et H6, en précisant que si E6 ou H6 sont vides, les shapes sont toutes masquées

ci joint un exemple concret afin d'être mieux compris

merci d'avance pour votre collaboration

cdt
 

Pièces jointes

  • Classeur1.xlsm
    12.2 KB · Affichages: 6
Dernière édition:
Solution
F
Salut, teste ceci. Je me suis basé sur ton exemple, donc tes shapes se nomment "Rectangle" et tes valeurs sont situées dans la plage A18:A26. Modifie si besoin.

VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ws As Worksheet
    Dim shp As Shape
    Dim i As Integer
    Dim cellValue As Double
    Dim lowerLimit As Variant
    Dim upperLimit As Variant

    Set ws = ThisWorkbook.Sheets("Feuil1")
    lowerLimit = ws.Range("E6").Value
    upperLimit = ws.Range("H6").Value

    ' Vérifie si la modification a eu lieu dans la plage des valeurs
    If Intersect(Target, Union(ws.Range("A18:A26"), ws.Range("E6"), ws.Range("H6"))) Is Nothing Then Exit Sub

    'Si E6 et H6 vides
    If IsEmpty(lowerLimit) Or IsEmpty(upperLimit)...
Trier par date Trier par votes
F

Franc58

XLDnaute Occasionnel
Salut, teste ceci. Je me suis basé sur ton exemple, donc tes shapes se nomment "Rectangle" et tes valeurs sont situées dans la plage A18:A26. Modifie si besoin.

VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ws As Worksheet
    Dim shp As Shape
    Dim i As Integer
    Dim cellValue As Double
    Dim lowerLimit As Variant
    Dim upperLimit As Variant

    Set ws = ThisWorkbook.Sheets("Feuil1")
    lowerLimit = ws.Range("E6").Value
    upperLimit = ws.Range("H6").Value

    ' Vérifie si la modification a eu lieu dans la plage des valeurs
    If Intersect(Target, Union(ws.Range("A18:A26"), ws.Range("E6"), ws.Range("H6"))) Is Nothing Then Exit Sub

    'Si E6 et H6 vides
    If IsEmpty(lowerLimit) Or IsEmpty(upperLimit) Then
        'Parcourt tous les shapes et les masque
        For i = 1 To 9
            Set shp = ws.Shapes("Rectangle " & i)
            shp.Visible = msoFalse
        Next i
    Else
        'Sinon parcourt tous les shapes
        For i = 1 To 9
            Set shp = ws.Shapes("Rectangle " & i)
            cellValue = ws.Range("A" & i + 17).Value
            'et compare valeur en A avec E6 et H6
            If cellValue < lowerLimit Or cellValue > upperLimit Then
                shp.Visible = msoFalse
            Else
                shp.Visible = msoTrue
            End If
        Next i
    End If
End Sub
 
Vote positif 0 Vote négatif
Solution
P

pat66

XLDnaute Impliqué
Bonsoir,

c'est tout simplement parfait, je te remercie beaucoup...

A partir de ta solution j'ai essayé de réaliser la même chose avec d'autres shapes, mais je n'y arrive pas, pourrais tu m'aider à modifié ta solution dans ce sens, je te remercie par avance pour ton aide et ta compréhension

voir exemple ci joint complété
 

Pièces jointes

  • Classeur1-complet.xlsm
    21.4 KB · Affichages: 3
Dernière édition:
Vote positif 0 Vote négatif
P

pat66

XLDnaute Impliqué
mêmes cellules que pour A18, cad Miminum =E6 Maximum H6
exemple
A18 = 100 et B18 = 10, Si le shapes supérieur s'affiche alors le shape inférieur s'affiche aussi
A19 = 150 et B19 = 11, idem
etc....
 
Dernière édition:
Vote positif 0 Vote négatif
F

Franc58

XLDnaute Occasionnel
OK, mais comme les 2 séries de shapes n'ont pas le même ordre de grandeur, en fonction de min et max, une de 2 séries sera toujours complètement masquée.

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ws As Worksheet
    Dim shp As Shape
    Dim i As Integer
    Dim cellValue As Double
    Dim lowerLimit As Variant
    Dim upperLimit As Variant

    Set ws = ThisWorkbook.Sheets("Feuil1")
    lowerLimit = ws.Range("E6").Value
    upperLimit = ws.Range("H6").Value

    ' Vérifie si la modification a eu lieu dans une cellule d'intérêt
    If Intersect(Target, Union(ws.Range("A18:A26"), ws.Range("B18:B26"), ws.Range("E6"), ws.Range("H6"))) Is Nothing Then Exit Sub

    'Si E6 et H6 vides
    If IsEmpty(lowerLimit) Or IsEmpty(upperLimit) Then
        'Parcourt tous les shapes et les masque
        For i = 1 To 18
            Set shp = ws.Shapes("Rectangle " & i)
            shp.Visible = msoFalse
        Next i
    Else
        'Sinon parcourt tous les shapes
        For i = 1 To 9
            Set shp = ws.Shapes("Rectangle " & i)
            cellValue = ws.Range("A" & i + 17).Value
            'et compare valeur en A avec E6 et H6
            If cellValue < lowerLimit Or cellValue > upperLimit Then
                shp.Visible = msoFalse
            Else
                shp.Visible = msoTrue
            End If
        Next i
        For i = 10 To 18
            Set shp = ws.Shapes("Rectangle " & i)
            cellValue = ws.Range("B" & i + 8).Value
            'et compare valeur en B avec E6 et H6
            If cellValue < lowerLimit Or cellValue > upperLimit Then
                shp.Visible = msoFalse
            Else
                shp.Visible = msoTrue
            End If
        Next i
    End If
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

P
  • Résolu(e)
Microsoft 365 Afficher / masquer des shapes ou des groupes de shapes avec condition mini/maxi
2
Réponses
27
Affichages
880
pat66
P
N
  • Question
Microsoft 365 afficher/masquer des lignes en fonction de la valeur d'une cellule qui aura été renseignée par une autre feuille (via un copier/collé automatique)
Réponses
5
Affichages
444
Nel'
N
  • Résolu(e)
Microsoft 365 Masquer des colonnes aux cellules avec valeurs données selon sélection d'une liste déroulante
Réponses
5
Affichages
798
PatFr38
  • Question
XL 2016 Afficher les lignes du mois courant sauf avec critères "En cours" macro VBA excel
Réponses
3
Affichages
668
Wayki
F
  • Question
XL 2019 Masquer des lignes avec VBA si supérieures ou inférieures à une date définie
3 4 5
Réponses
72
Affichages
6 K
FloASF63
F
  • Question
XL 2019 Afficher ou masquer une forme selon l'état visibilité d'une feuille.
Réponses
4
Affichages
2 K
mapomme
C
  • Résolu(e)
XL 2016 Remplir automatiquement un tableau d'après des conditions et des valeurs
Réponses
11
Affichages
1 K
ERIC S
  • Résolu(e)
XL 2010 Masquer lignes avec Select et RAZ des lignes masquées
Réponses
2
Affichages
798
Orson83
  • Question
XL 2016 De l'influence d'une police non horizontale sur l'impression des objets graphiques
Réponses
1
Affichages
608
mapomme
  • Résolu(e)
XL 2019 Afficher ou masquer dynamiquement des lignes, selon la valeur d'une cellule.
Réponses
14
Affichages
5 K
JohDan
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…