Macro coche

Bonjour à tous,

j'ai une macro qui permet lorsque l'on clique sur une cellule de mettre un 1 dedans.

mais comment empêcher de mettre plusieurs 1 sur une même ligne?

je vous joins mon ficher avec la macro

merci

oza

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
If Not Application.Intersect(Target, Range("D6:L24")) Is Nothing Then
    If Target.Value = "" Then
        Range(Cells(Target.Row, 4), Cells(Target.Row, 12)).Value = ""
        Target.Value = "1"
    Else
        Target.Value = ""
    End If
End If
End Sub

dans le fond, tu efface la ligne avant d'écrire ton 1

merci Math!

tu m'as bien avancé.

il y a un autre problème également: lors d'un cliquer - glisser des 1 se mettent dans chaque cellule.

as tu idées pour empêcher cela?

en tout cas merci

oza

bonjour

voila ma solution

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

On Error Resume Next
If Not Application.Intersect(Target, Range("D6:L24")) Is Nothing Then

If Target.Value = "" Then

            If Selection.End(xlToRight).Value = 1 Or Selection.End(xlToLeft).Value = 1 Then
            Target.Value = ""

            Else
            Target.Value = "1"

            End If
ElseIf Target.Value = "1" Then

Target.Value = ""

End If
End If
End Sub

fonctionne tres bien seul soucis c'est si on fait un clic et on selection plusieur cellule a la fois il met un 1 dans toutes les cellule selectionner

voila a+

ah merci spyderpaint!

c'est intéressant tu n'as pas la même méthode que Math je vais pouvoir me faire les dents sur vos deux méthodes et voir laquelle convient le mieux.

as tu une idée justement pour éviter se problème de cliquer - glisser?

J'ai ajouté un test pour voir si la sélection compte plus d'une cellule, si oui on fait rien. J'ai aussi enlevé le test pour voir si la cellule correspond à rien.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
    If Not Application.Intersect(Target, Range("D6:L24")) Is Nothing Then
        If Target.Cells.Count > 1 Then Exit Sub
        Range(Cells(Target.Row, 4), Cells(Target.Row, 12)).Value = ""
        Target.Value = "1"
    Else
        Target.Value = ""
    End If
End Sub

impeccable merci beaucoup Math!

je reviens vers vous,

est - ce possible de rendre obligatoire une coche sur certaine ligne?

dans mon fichier, l'utilisateur doit répondre au questionnaire et passer à l'étape suivante.

comment empêcher le passage (via bouton "étape suivante") si l'utilisateur n'a pas répondu aux questions en gras?

j'ai remarqué un bug sur le fichier, quand on clique sur la colonne A:C son contenu s'efface...

une idée?

en tout cas merci!

Pour les colonnes A:C qui s'effacent, le problème vient de la ligne

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

On Error Resume Next

If Not Application.Intersect(Target, Range("D6:L24")) Is Nothing Then

If Target.Cells.Count > 1 Then Exit Sub

Range(Cells(Target.Row, 4), Cells(Target.Row, 12)).Value = ""

Target.Value = "1"

Else

Target.Value = ""

End If

End Sub

Si la sélection n'est pas entre D6 et L24, le contenue s'éfface. Tu pourrais supprimer le else.

Pour la vérification de certaines lignes, j'ai fait un exemple avec la ligne 6. Je calcul la somme de la ligne, si elle est égale à 0, un message d'erreur apparait. Si tu veux ajouter d'autre ligne, refait le même principe avec chaque ligne en ajoutant le code entre le With.

Private Function Verification() As Boolean

    Verification = True

    With Sheets("Feuil1")
        'Test sur la ligne 6
        If Application.WorksheetFunction.Sum(.Range("D6:L6")) = 0 Then
            Verification = False
            MsgBox "La ligne 6 doit être remplie"
        End If
    End With

End Function

et pour utiliser la fonction

Sub Macro1()
    If Verification Then
        Sheets("Feuil2").Select
        Range("A1").Select
    End If
End Sub

merci Math!