Je cherche a cr=E9er une private sub qui me prompterait lorsque le
nombre d'entr=E9es/cellules non vides sur une m=EAme ligne ex=E9dent 5 dans
un Range("C2:C31,E2:E31,G2:G31,....,IC2:IC31)
Si le nombre d'entr=E9es sur une m=EAme ligne dans le range indiqu=E9 est
>=3D5 alors un MsgBox indique Ceci est le x=E8me rendez-vous =E0 cette
horaire, voulez-vous le valider?
OUI ou NON
Si OUI alors l'entr=E9e s'affiche en Gras et en Rouge
SI NON l'entr=E9e est effac=E9e.
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Caetera
"Christophe" a écrit dans le message de news:
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
"Christophe" <christophe.joly@trade.gov> a écrit dans le message de news:
761966a9-487b-409f-8ab1-ef8e46a7c501@y3g2000vbm.googlegroups.com...
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
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
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
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
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
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 !!!!!
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
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
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" <EtiennePloufCahé@wanadoo.fr> wrote:
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
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" <EtiennePloufCahé@wanadoo.fr> wrote:
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
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" <EtiennePloufCahé@wanadoo.fr> wrote:
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
"Christophe" a écrit dans le message de news:
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" <christophe.joly@trade.gov> a écrit dans le message de news:
27cb9f00-9727-440c-af16-aaa1e63afac5@t7g2000vbj.googlegroups.com...
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
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
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
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
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
Merci pour ces précisions.
Christophe
On 24 sep, 16:59, "Caetera" <EtiennePloufCahé@wanadoo.fr> wrote:
"Christophe" a écrit dans le message de new s:
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
Merci pour ces précisions.
Christophe
On 24 sep, 16:59, "Caetera" <EtiennePloufCahé@wanadoo.fr> wrote:
"Christophe" <christophe.j...@trade.gov> a écrit dans le message de new s:
27cb9f00-9727-440c-af16-aaa1e63af...@t7g2000vbj.googlegroups.com...
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
On 24 sep, 16:59, "Caetera" <EtiennePloufCahé@wanadoo.fr> wrote:
"Christophe" a écrit dans le message de new s:
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
