Sub makro1()
    Dim shps As Shapes, shp As Shape
    Dim i As Long, x1,x2,y1,y2
    Set shps = ActiveSheet.Shapes
    Set shp = ActiveSheet.Shapes("Прямоугольник 1")
    For i = 1 To shps.Count
        If Not shps(i) Is shp And shps(i).Name <> "Oval 19" Then
            x1 = shps(i).Left + shps(i).Width / 2
            y1 = shps(i).Top + shps(i).Height / 2
            x2 = shp.Left + shp.Width / 2
            y2 = shp.Top + shp.Height / 2
            If ((x2 - x1) ^ 2 + (y2 - y1) ^ 2) ^ 0.5 > 100 Then
                shps(i).Fill.Transparency = 1
                shps(i).Line.Transparency = 1
            Else
                shps(i).Fill.Transparency = 0
                shps(i).Line.Transparency = 0
            End If
        End If
    Next i
End Sub

Sub makro1()
    Dim shps As Shapes, shp As Shape
    Dim i As Long, x1, x2, y1, y2
    Set shps = ActiveSheet.Shapes
    Set shp = ActiveSheet.Shapes([k3])
    x2 = shp.Left + shp.Width / 2
    y2 = shp.Top + shp.Height / 2
    For i = 1 To shps.Count
          With shps(i)
            If Not (Intersect(.TopLeftCell, [B4:S45]) Is Nothing Or Intersect(.BottomRightCell, [B4:S45]) Is Nothing) Then
              x1 = shps(i).Left + shps(i).Width / 2
              y1 = shps(i).Top + shps(i).Height / 2
              shps(i).Fill.Transparency = -(((x2 - x1) ^ 2 + (y2 - y1) ^ 2) ^ 0.5 > 100)
              shps(i).Line.Transparency = shps(i).Fill.Transparency
            End If
          End With
    Next i
End Sub