Création de fausse case à cocher

[fred2705]

J’ai dépassé le nombre de case à cocher autoriser dans excel 2003, j’ai entendu parler de la possibilité de réaliser de fausse casse à cocher…j’ai un début de code mais comme je suis un débutant en VBA, je sèche !

Voici mon exemple en fichier joint, merci pour votre aide.

 

[Modeste]

Re : Création de fausse case à cocher

Bonjour fred2705,

Pas certain d'avoir bien compris ... et pas sûr non plus que l'événement SelectionChange soit le plus adapté ... mais essaie ce qui suit (en mettant toute la plage D2 à D10 en police Wingdings, 11, gras, centré, etc.):

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

[Edit:] Salut Si...

 

[Si...]

Re : Création de fausse case à cocher

salut

pour un clin d'oeil à Modeste

La plage étant déjà formatée (police Wingdings, taille..)

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

 

[Iznogood1]

Re : Création de fausse case à cocher

Autre proposition

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

et si on n'est pas "attaché" à vrai/faux, on peut optimiser

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

 

[fred2705]

Re : Création de fausse case à cocher

C'est parfait merci à tous.