Saisie automatique dans une colonne en fonction d'une autre colonne
Bonjour le forum,
Dans l’extrait de mon fichier de travail (en PJ) et afin de ne pas oublier une éventuelle saisie dans la colonne "X" si j'inscris "En cours" dans la colonne "R", j'ai voulu adapter la procédure "Private Sub Worksheet_Change(ByVal Target As Range)" de la "feuil1" mais ça ne marche pas. Est-ce que quelqu'un pourrait me dire qu'est-ce qui ne va pas dans la partie de mon module ci-dessous :
'Saisie du numéro de FUD automatiquement si souhaitez
If Target.Row < 3 Then Exit Sub
For Each fud In Target.Rows
If Me.Cells(fud.Row, 18) = "En cours" Then
réponse_fud1 = MsgBox("Voulez-vous copier le numéro de FUD dans la colonne X", vbYesNo)
If réponse_fud1 = vbNo Then Exit Sub
Else
num_fud = InputBox("Saisir le numéro du FUD")
Me.Cells(fud.Row, 18).Value = num_fud
End If
Next fud
La finalité est que lorsque je saisis dans la colonne "R" le mot clé "En cours" une boite de message me demande si je souhaite inscrire le numéro correspondant à ce FUD. Si réponse « NON » le test me fait sortir de la boucle et non pas de la procédure comme j'ai fait.
Si « OUI » une nouvelle fenêtre me demande de saisir le numéro du FUD (format texte) et le met directement dans la colonne X.
Cordialement
Bonjour,
Essayez ce code:
Private Sub Worksheet_Change(ByVal Target As Range)
'Saisie du numéro de FUD automatiquement si souhaitez
If Target.Row < 3 Then Exit Sub
If Target.Value = "En cours" Or Target.Value = "en cours" Then
If MsgBox("Voulez-vous copier le numéro de FUD dans la colonne X", vbYesNo) = vbNo Then
Exit Sub
Else
num_fud = InputBox("Saisir le numéro du FUD")
Me.Cells(Target.Row, 24).Value = num_fud
End If
End If
End Sub
Cordialement
Avec le fichier
Bonjour,
A partir du moment ou tu utilises la procédure événementielle Change(), je ne vois pas l'intérêt de faire une boucle (il te faut juste valider la première fois les quelques cellules qui ont comme valeur "En cours" et ensuite ça sera automatique) :
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row < 3 Then Exit Sub
If Target.Column <> 18 Then Exit Sub
If Target.Count > 1 Then Exit Sub
If Target.Value = "En cours" Then
If MsgBox("Voulez-vous copier le numéro de FUD dans la colonne X", vbYesNo) = vbNo Then Exit Sub
Application.EnableEvents = False
Cells(Target.Row, 24).Value = InputBox("Saisir le numéro du FUD")
End If
Application.EnableEvents = True
End Sub
Merci à "besoin_d_aide" et à Theze. Les deux solutions fonction correctement.
Je mets le sujet en résolu. Juste une peite question complémentaire : comment je peux faire pour sortir du "if" et non pas de la procédure ? Actuellement j'ai "Exit Sub" mais je souhaiterai plutôt une sorte de "Exit If" aux lignes :
If Target.Row < 3 Then Exit Sub
If Target.Column <> 18 Then Exit Sub
If Target.Count > 1 Then Exit Sub
Car après ces lignes de commandes j'en ai d'autre qui ne s'exécutent pas si je suis sorti de la procédure.
Sinon merci encore.
Cordialement
Re,
Une possibilité est d'utiliser GoTo mais avec prudence !
Tu peux peut être nous montrer tout ton code pour voir si il n'y a pas une solution plus propre :
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row < 3 Then GoTo Reprise
If Target.Column <> 18 Then GoTo Reprise
If Target.Count > 1 Then GoTo Reprise
If Target.Value = "En cours" Then
If MsgBox("Voulez-vous copier le numéro de FUD dans la colonne X", vbYesNo) = vbNo Then Exit Sub
Application.EnableEvents = False
Cells(Target.Row, 24).Value = InputBox("Saisir le numéro du FUD")
End If
Application.EnableEvents = True
Reprise:
'ici ton autre code...
End Sub
Aussitôt demandé aussitôt fait 😂. J'ai intégré les deux solutions proposées dans la macro mais seulement une est activé.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, d, t, i&, derln&
Dim num_fud As String
derln = Range("A" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
'Application.EnableEvents = False
If Not Intersect(Target, Range("G3:H" & derln)) Is Nothing Then
For i = 3 To derln
If Range("G" & i) <> "" Then
If Not IsDate(Range("G" & i)) Or Not IsDate(Range("H" & i) + 1) Then
MsgBox "Date incorrecte à la ligne " & i, 16
Range("G" & i & ":H" & i).Select
Exit Sub
ElseIf Year(Range("G" & i)) < 1900 Or Year(Range("H" & i)) < 1900 Then
MsgBox "Saisie de date incorrecte à la ligne " & i, 16
Range("G" & i & ":H" & i).Select
Exit Sub
ElseIf Range("G" & i) > Range("H" & i) Then
MsgBox "Erreur de saisie à la ligne " & i & Chr(13) & _
"La date de début ne peut pas être postérieure à celle de fin.", 16
Range("G" & i & ":H" & i).Select
Exit Sub
End If
End If
Next i
End If
'Saisie du numéro de FUD automatiquement si souhaitez
If Target.Row < 3 Then Exit Sub
If Target.Value = "En cours" Or Target.Value = "en cours" Then
If MsgBox("Voulez-vous copier le numéro de FUD dans la colonne X", vbYesNo) = vbNo Then
Exit Sub
Else
num_fud = InputBox("Saisir le numéro du FUD")
Me.Cells(Target.Row, 24).Value = num_fud
End If
End If
'If Target.Row < 3 Then Exit Sub
' If Target.Column <> 18 Then Exit Sub
' If Target.Count > 1 Then Exit Sub
' If Target.Value = "En cours" Then
' If MsgBox("Voulez-vous copier le numéro de FUD dans la colonne X", vbYesNo) = vbNo Then Exit Sub
' Cells(Target.Row, 24).Value = InputBox("Saisir le numéro du FUD")
' End If
If Target.Row < 3 Or Target.Column < 11 Or (Target.Column > 14 And Target.Column < 19) Or Target.Column > 19 Then Exit Sub
d = Date: t = Time
For Each r In Target.Rows
If Me.Cells(r.Row, 12) <> "" Or Me.Cells(r.Row, 13) <> "" Or Me.Cells(r.Row, 14) <> "" Or Me.Cells(r.Row, 19) <> "" Then
Me.Cells(r.Row, 33).Value = d
Me.Cells(r.Row, 34).Value = t
Me.Cells(r.Row, 40).ClearContents
Else
Me.Cells(r.Row, 33).Resize(, 2).ClearContents
End If
Next r
Application.ScreenUpdating = True
'Application.EnableEvents = True
End Sub