Scopri e nascondi forme in relazione a una data

Sub Worksheet_Change(ByVal Target As Range)
Dim Area As Range, Rg As Object, DT As Date
DT = Date
If Not Intersect(Target, Range("D10:D25")) Is Nothing Then
    Set Area = Sheets("Foglio1").Range("D10:D25")
    Set Rg = Area.Find(DT, LookIn:=xlValues, LookAt:=xlWhole)
        If Rg Is Nothing Then
            Sheets("Foglio1").Shapes("Rettangolo arrotondato 1").Visible = False
        Else
            Sheets("Foglio1").Shapes("Rettangolo arrotondato 1").Visible = True
        End If
Set Area = Nothing	
Set Rg = Nothing
End If
If Not Intersect(Target, Range("D30:D45")) Is Nothing Then
    Set Area = Sheets("Foglio1").Range("D30:D45")
    Set Rg = Area.Find(DT, LookIn:=xlValues, LookAt:=xlWhole)
        If Rg Is Nothing Then
            Sheets("Foglio1").Shapes("Ovale 2").Visible = False
        Else
            Sheets("Foglio1").Shapes("Ovale 2").Visible = True
        End If
Set Area = Nothing	
Set Rg = Nothing
End If
End Sub

Option Explicit

Private Sub Workbook_Open()

    Dim data As Range
    
    With Sheets(1)
        For Each data In .Range("C10:C25")
            If data = Range("C3") Then
                .Shapes("Oval 4").Visible = True
                Exit For
            Else
                .Shapes("Oval 4").Visible = False
            End If
        Next data
        For Each data In .Range("C30:C45")
            If data = Range("C3") Then
                .Shapes("Heart 5").Visible = True
                Exit For
            Else
                .Shapes("Heart 5").Visible = False
            End If
        Next data
        For Each data In .Range("C50:C65")
            If data = Range("C3") Then
                .Shapes("Fumetto 3 6").Visible = True
                Exit For
            Else
                .Shapes("Fumetto 3 6").Visible = False
            End If
        Next data
    End With
    
End Sub