Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, [A6:N9]) Is Nothing Then Exit Sub 'plage à adapter
Dim lig, x#, y#, s As Shape
Cancel = True
lig = Target.Row - 3
'---initialisation à adapter
x = [J15].Left + [J15].Width / 2
y = [J15].Top
'---RAZ à adapter---
Application.ScreenUpdating = False
For Each s In Shapes
If Not Intersect(s.TopLeftCell, [J14:N1000]) Is Nothing Then s.Delete
Next
'---Copies des Shapes à adapter---
CopieShape [K4:M4], lig, Shapes("Picture 66"), x, y, "Réhausse"
CopieShape [J4], lig, Shapes("Picture 63"), x, y, "Dalle"
CopieShape [E4:I4], lig, Shapes("Picture 67"), x, y, "TR"
CopieShape [B4:D4], lig, Shapes("Picture 64"), x, y, "ED"
If y > [J15].Top Then CopieShape [A4], lig, Shapes("Picture 65"), x, y, "FDR ht", 1
Application.ScreenUpdating = True
End Sub
Sub CopieShape(r As Range, lig, s As Shape, x#, y#, titre$, Optional der As Byte = 0)
Dim i, h#, w#
For Each r In r
For i = 1 To IIf(der, 1, Val(r(lig)))
s.Copy
Paste
Selection.Left = x
Selection.Top = y
h = Selection.Height
w = Selection.Width
y = y + h
OLEObjects("Label1").Copy
Paste
Selection.Object.WordWrap = False
Selection.Object.AutoSize = False
Selection.Object.Caption = titre & " " & _
IIf(der, 100 * Val(Replace(r(lig), ",", ".")), r)
Selection.Object.AutoSize = True
Selection.Left = x + w + 10
Selection.Top = y - h / 2 - Selection.Height / 2
ActiveCell.Activate
Next
Next
End Sub