Message si nombre d'entrée sur une ligne excède 5

Le
Christophe
Bonjour:

Je cherche a crer une private sub qui me prompterait lorsque le
nombre d'entres/cellules non vides sur une mme ligne exdent 5 dans
un Range("C2:C31,E2:E31,G2:G31,.,IC2:IC31)

Si le nombre d'entres sur une mme ligne dans le range indiqu est
>=5 alors un MsgBox indique Ceci est le xme rendez-vous cette
horaire, voulez-vous le valider?
OUI ou NON
Si OUI alors l'entre s'affiche en Gras et en Rouge
SI NON l'entre est efface.

Remerciements et sincres salutations.

Christophe
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Caetera
Le #22607631
"Christophe"
Je cherche a créer une private sub qui me prompterait lorsque le
nombre d'entrées/cellules non vides sur une même ligne exédent 5 dans
un Range("C2:C31,E2:E31,G2:G31,....,IC2:IC31)

Si le nombre d'entrées sur une même ligne dans le range indiqué est
=5 alors un MsgBox indique Ceci est le xème rendez-vous à cette


horaire, voulez-vous le valider?
OUI ou NON
Si OUI alors l'entrée s'affiche en Gras et en Rouge
SI NON l'entrée est effacée.

******************

D'abord nommer la plage ("leRange") puis dans le module de la feuille :

Private Sub Worksheet_Change(ByVal Target As Range)
Set isect = Application.Intersect(Target, [leRange])
If Not isect Is Nothing Then
x = Application.CountA([leRange])
If x >= 5 Then
alert = MsgBox("Ceci est le " & x & "° rendez-vous à cet horaire,
voulez-vous le valider ?", vbYesNo + vbCritical, "CONTROLE")
If alert = vbYes Then
Target.Font.Bold = True
Target.Font.ColorIndex = 3
End If
End If
End If
End Sub

Etc
Caetera
Le #22607621
Il manque un morceau de code pour réponse "Non" :

Private Sub Worksheet_Change(ByVal Target As Range)
Set isect = Application.Intersect(Target, [leRange])
If Not isect Is Nothing Then
x = Application.CountA([leRange])
If x >= 5 Then
alert = MsgBox("Ceci est le " & x & "° rendez-vous à cet horaire,
voulez-vous le valider ?", vbYesNo + vbCritical, "CONTROLE")
If alert = vbYes Then
Target.Font.Bold = True
Target.Font.ColorIndex = 3
Else
Application.EnableEvents = False
Target = ""
Application.EnableEvents = True
End If
End If
End If
End Sub

Etc
FFO
Le #22607711
Dans le VBA de la feuille mets ce code :

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row > 1 And Target.Row < 33 And Target <> "" Then
On Error Resume Next
Nombre = Range("C" & Target.Row, "IC" &
Target.Row).SpecialCells(xlCellTypeConstants).Count
If Nombre >= 5 And Nombre <> "" Then
If MsgBox("Ceci est le " & Nombre & " rendez-vous à cette horaire,
voulez-vous le valider?", vbYesNo) = vbYes Then
Target.Font.Bold = True
Target.Font.ColorIndex = 3
Else
Application.EnableEvents = False
Target = ""
Application.EnableEvents = True
End If
End If
End If
End Sub

Celà devrait convenir

Dis moi !!!!!
Christophe
Le #22608341
Etienne:

Merci beaucoup. J'ai plusieurs questions.

1- J'avais effectivement noté que ta 1ere proposition n'avais pas la
partie du code NON mais sinon cela semblait fonctionner a condition
d'enlever l'1 des 3 End If à la fin sinon j'avais une erreur de
compilation.

2- Ta deuxieme proposition me donne egalement une erreur de
compilation sur le End If et de plus mes saisies sont effacées pour
chaque entree dans le range.

3- J'ai une autre private sub dans la meme feuille Private Sub
Worksheet_Change(ByVal Target As Range) et donc obtient une erreur de
compilation (Ambiguous name detected: Worksheet_Change) si je ne la
neutralise pas. comment faire coexister les 2 private sub?


Remerciements et sincères salutations.

Christophe

On 24 sep, 14:25, "Caetera"
Il manque un morceau de code pour réponse "Non" :

Private Sub Worksheet_Change(ByVal Target As Range)
Set isect = Application.Intersect(Target, [leRange])
If Not isect Is Nothing Then
      x = Application.CountA([leRange])
      If x >= 5 Then
            alert = MsgBox("Ceci est le " & x & "° rendez -vous à cet horaire,
voulez-vous le valider ?", vbYesNo + vbCritical, "CONTROLE")
            If alert = vbYes Then
                  Target.Font.Bold = True
                  Target.Font.ColorIndex = 3
            Else
                  Application.EnableEvents = False
                   Target = ""
                  Application.EnableEvents = True
            End If
      End If
End If
End Sub

Etc
Caetera
Le #22608431
"Christophe"
Etienne:

Merci beaucoup. J'ai plusieurs questions.

1- J'avais effectivement noté que ta 1ere proposition n'avais pas la
partie du code NON mais sinon cela semblait fonctionner a condition
d'enlever l'1 des 3 End If à la fin sinon j'avais une erreur de
compilation.

2- Ta deuxieme proposition me donne egalement une erreur de
compilation sur le End If et de plus mes saisies sont effacées pour
chaque entree dans le range.

3- J'ai une autre private sub dans la meme feuille Private Sub
Worksheet_Change(ByVal Target As Range) et donc obtient une erreur de
compilation (Ambiguous name detected: Worksheet_Change) si je ne la
neutralise pas. comment faire coexister les 2 private sub?

********************
Pour 1 et 2 :
L'instruction suivante doit être sur UNE SEULE LIGNE

alert = MsgBox("Ceci est le " & x & "° rendez-vous à cet horaire,
voulez-vous le valider ?", vbYesNo + vbCritical, "CONTROLE")

Pour 3 :
Impossible d'avoir 2 Private Sub Worksheet_Change ou une quelconque autre
évènementielle dans le code d'une même feuille.
Doit intégrer toutes tes instructions dans la même Private Sub

Etc
Christophe
Le #22613721
Bonjour:

Francois a proposé la solution ci-dessous qui fonctionne
parfaitement. Merci.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row > 1 And Target.Row < 32 And Target <> "" Then
i = 3
Do While Cells(Target.Row, i).Column < Range("IC" & Target.Row).Column
+1
If Cells(Target.Row, i) <> "" Then
Nombre = Nombre + 1
End If
i = i + 2
Loop
If Nombre >= 5 And Nombre <> "" Then
If MsgBox("Ceci est le " & Nombre & " rendez-vous à cette horaire,
voulez-vous le valider?", vbYesNo) = vbYes Then
Target.Font.Bold = True
Target.Font.ColorIndex = 3
Else
Application.EnableEvents = False
Target = ""
Application.EnableEvents = True
End If
End If
End If
End Sub
Christophe
Le #22620111
Merci pour ces précisions.

Christophe


On 24 sep, 16:59, "Caetera"
"Christophe"
Etienne:

Merci beaucoup.  J'ai plusieurs questions.

1- J'avais effectivement noté que ta 1ere proposition n'avais pas la
partie du code NON mais sinon cela semblait fonctionner a condition
d'enlever l'1 des 3 End If à la fin sinon j'avais une erreur de
compilation.

2- Ta deuxieme proposition me donne egalement une erreur de
compilation sur le End If et de plus mes saisies sont effacées pour
chaque entree dans le range.

3- J'ai une autre private sub dans la meme feuille Private Sub
Worksheet_Change(ByVal Target As Range) et donc obtient une erreur de
compilation (Ambiguous name detected: Worksheet_Change) si je ne la
neutralise pas. comment faire coexister les 2 private sub?

********************
Pour 1 et 2 :
L'instruction suivante doit être sur UNE SEULE LIGNE

alert = MsgBox("Ceci est le " & x & "° rendez-vous à cet horaire,
voulez-vous le valider ?", vbYesNo + vbCritical, "CONTROLE")

Pour 3 :
Impossible d'avoir 2 Private Sub Worksheet_Change ou une quelconque autre
évènementielle dans le code d'une même feuille.
Doit intégrer toutes tes instructions dans la même  Private Sub

Etc
Publicité
Poster une réponse
Anonyme