Private Sub Worksheet_Change(ByVal Target As Range)
Dim xcell As Range
If Intersect(Target, Range("b2:b57")) Is Nothing Then Exit Sub
For Each xcell In Range("b2:b57")
If Existe(xcell.Offset(, -1)) Then
If xcell >= 0 Then
With ActiveSheet.Shapes(xcell.Offset(, -1).Value & "P")
.Visible = True
.Height = HP * xcell.Value / Range("s4")
.Top = ActiveSheet.Shapes(xcell.Offset(, -1).Value & "N").Top - .Height
End With
ActiveSheet.Shapes(xcell.Offset(, -1).Value & "N").Visible = False
Else
With ActiveSheet.Shapes(xcell.Offset(, -1).Value & "N")
.Visible = True
.Height = -HN * xcell.Value / Range("s8")
End With
ActiveSheet.Shapes(xcell.Offset(, -1).Value & "P").Visible = False
End If
End If
Next xcell
End Sub
Function Existe(x As Range) As Boolean
Dim shp As Shape
For Each shp In ActiveSheet.Shapes
If shp.Name = x.Value & "P" Then
Existe = True
Exit Function
End If
Next shp
End Function
Public Function HP()
HP = Sheets("EUROPE").Shapes("CylP").Height
End Function
Function HN()
HN = Sheets("EUROPE").Shapes("CylN").Height
End Function