Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("b4:f23")) Is Nothing Then
Cells(Target.Row, "b").Resize(, 5).ClearContents
Target.Font.Name = "Wingdings"
Target = Chr(108)
Cancel = True
Tracer
End If
End Sub
Sub Tracer()
Dim xshp As Shape, derlig&, i&, k&
Dim debH, debV, finH, finV
Application.ScreenUpdating = False
With Sheets("Feuil1")
For Each xshp In .Shapes
If xshp.Name Like "Ma-Ligne*" Then xshp.Delete
Next xshp
derlig = .Cells(.Rows.Count, "a").End(xlUp).Row
If derlig = 4 Then Exit Sub
For i = 4 To derlig - 1
For k = 2 To 6
If .Cells(i, k) <> "" Then Exit For
Next k
If k <= 6 Then
debH = .Cells(i, k).Left + .Cells(i, k).Width / 2
debV = .Cells(i, k).Top + .Cells(i, k).Height / 2
For k = 2 To 6
If .Cells(i + 1, k) <> "" Then Exit For
Next k
If k <= 6 Then
finH = .Cells(i + 1, k).Left + .Cells(i + 1, k).Width / 2
finV = .Cells(i + 1, k).Top + .Cells(i + 1, k).Height / 2
With .Shapes.AddConnector(msoConnectorStraight, debH, debV, finH, finV)
.Name = "Ma-Ligne" & i
.Line.Weight = 2.5
.Line.ForeColor.RGB = RGB(0, 0, 255)
End With
End If
End If
Next i
End With
End Sub