Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, [A1,A101]) Is Nothing Then Exit Sub
Dim P As Range, i As Byte, image As Shape, X#, Y#
Cancel = True
Application.Goto Target, True 'cadrage
Set P = Target.CurrentRegion
Shapes("CarteFrance").Top = P.Rows(2).Top
For i = 3 To P.Rows.Count
Set image = Shapes(P(i, 1))
X = X + P(i, 4) * (image.Left + image.Width / 2)
Y = Y + P(i, 4) * (image.Top + image.Height / 2)
Next
X = X / Application.Sum(P.Columns(4))
Y = Y / Application.Sum(P.Columns(4))
Set image = Shapes("Barycentre")
image.Left = X - image.Width / 2
image.Top = Y - image.Height / 2
End Sub