Sub Макрос1()
    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 = .Left + .Width / 2
            y1 = .Top + .Height / 2
            .Fill.Transparency = -(((x2 - x1) ^ 2 + (y2 - y1) ^ 2) ^ 0.5 > 100)
            .Line.Transparency = .Fill.Transparency
            If .Type = msoPicture Then .Visible = .Fill.Transparency = 0
            End If
        End With
    Next i
End Sub