Création de fausse case à cocher

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, [D2:D10]) Is Nothing Then
    If Target = "þ" Then
        Target.Offset(0, 1) = False
        Target = "o"
    Else
        Target = "þ"
        Target.Offset(0, 1) = True
    End If
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal R As Range)
  If R.Count > 1 Then Exit Sub 'traitement pour une seule cellule
  If R.Column <> 4 Or R = "" Then Exit Sub 'hors colonne D ou vide : sortie
  R = IIf(R = "þ", "o", "þ") 'permute les 2 cas
  R(1, 2) = R = "þ" 'vrai si = sinon faux
  R(1, 0).Select ''pour premettre une correction
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  If Not Intersect(Target, [E6:E9]) Is Nothing Then
    If Target.Value Then
      Target.Value = False
      Target.Offset(0, -1).Value = "o"
    Else
      Target.Value = True
      Target.Offset(0, -1).Value = "þ"
    End If
    Cancel = True
  End If
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  If Not Intersect(Target, [E6:E9]) Is Nothing Then
    With Target
      .Value = Not .Value
      .Offset(0, -1).Value = IIf(.Value, "þ", "o")
    End With
    Cancel = True
  End If
End Sub