Microsoft 365 Afficher /Masquer Shapes selon leurs valeurs

[pat66]

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

 

[Franc58]

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.

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

 

[pat66]

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é

 

[Franc58]

Dans quelles cellules indiques-tu les valeurs min et max pour les valeurs en rouge ?

 

[pat66]

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....

 

[Franc58]

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.

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

 

[pat66]

ha ok,

effectivement ça colle pas, je vais voir si je peux raisonner différemment, je reviens vers toi

en attendant je considère que tu as trouvé la solution au problème énoncé

merci