Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim NomSh As String, Sh As Shape
Set Target = Intersect(Target, Range("V7:V21"))
If Target Is Nothing Then Exit Sub
NomSh = Target.Offset(0, -1).MergeArea(1, 1).Value
If NomSh = "" Then Exit Sub
On Error Resume Next
Set Sh = ActiveSheet.Shapes(NomSh)
If Err Then
Set Sh = ActiveSheet.Shapes.AddShape(msoShapePentagon, Me.[B6].Left, Me.[B6].Top, Application.CentimetersToPoints(Target.Value / 10), 15)
Sh.Name = NomSh
End If
Sh.Width = Application.CentimetersToPoints(Target.Value / 10)
Sh.Top = [B6].Top
Sh.Left = [B6].Left
Sh.Height = 15
Sh.TextFrame.Characters.Text = NomSh
Cancel = True
End Sub