Evenement et 2 condition?

  • Initiateur de la discussion Initiateur de la discussion nicopof
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

N

nicopof

Guest
Bonjour, je souhaiterai savoir si avec la l'évènement Private Sub Worksheet_Change(ByVal Target As Range) ont peut mettre deux condition?

Cultuellement j'ai cette condition là:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
Dim tablCode
tablCode = Array(31, 34, 36, 18, 99)

If Target.Column = 21 Or Target.Column = 24 Or Target.Column = 27 Or Target.Column = 30 Then
For i = 0 To 4
If Target.Value = tablCode(i) Then

.....
la suite est l'envoie d'un mail.
Avant l'envoie du mail j'aimerai qu'une deuxième condition soit mit en place.

If Target.Column = 23 Or Target.Column = 26 Or Target.Column = 29 Or Target.Column = 32 Then
If target.value <>"" then

mail


Est-ce possible? si oui comment l'écrire correctement?
Merci
 
Re : Evenement et 2 condition?

Bonjour.

Ou bien avec un Select Case :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim I&
If Target.Count > 1 Then Exit Sub
If Intersect(Me.[U:AG], Target) Is Nothing Then Exit Sub
Dim TablCode()
TablCode = Array(31, 34, 36, 18, 99)
Select Case (Target.Column - 21) Mod 3 + 1
   Case 1:
      For I = 0 To 4
         If Target.Value = TablCode(I) Then
'.....
'la suite est l'envoie d'un mail.
   
'Avant l 'envoie du mail j'aimerai qu'une deuxième condition soit mit en place.
   Case 3:
      If Target.Value <> "" Then
'.....
   End Select
 
Re : Evenement et 2 condition?

Salut merci pour les réponse;
j'ai un peu de mal a l'intégrer a macr déjà existante

Private Sub Worksheet_Change(ByVal Target As Range)
Dim I&
If Target.Count > 1 Then Exit Sub
If Intersect(Me.[U:AG], Target) Is Nothing Then Exit Sub
Dim TablCode()
TablCode = Array(31, 34, 36, 18, 99)
Select Case (Target.Column - 21) Mod 3 + 1
Case 1:
For I = 0 To 4
If Target.Value = TablCode(I) Then
Case 3:
If Target.Value <> "" Then
'.....
End Select


'Macro email
'--------------------------------------------------------

If OutlookOuvert = False Then o = Shell("Outlook", vbNormalNoFocus)
Dim Email_Subject, Email_Send_From, Email_Send_To, _
Email_Cc, Email_Bcc, Email_Body As String
Dim Mail_Object, Mail_Single As Variant
Email_Subject = " DL " & TablCode(I)
Email_Send_From = "xxxx@gmail.com"
Email_Send_To = "xxxx@gmail.com"
Email_Cc = "xxxxx@gmail.com"
Email_Bcc = "xxxx@gmail.com"
Email_Body = "auto mail" & vbCr & _
"" & vbCr & _
"Un code " & TablCode(I) & " a été atritubé a un vol autjoudh'ui" & vbCr & _
vbCr & _
"Date : " & Cells(Target.Row, 1) & vbCr & _
"Nom agent: " & Cells(Target.Row, 2) & vbCr & _
"départ: " & Cells(Target.Row, 13) & vbCr & _
"STD: " & Format(Cells(Target.Row, 18), "hh:mm") & vbCr & _
"ATD: " & Format(Cells(Target.Row, 19), "hh:mm") & vbCr & _
"explication: " & Format(Cells(Target.Row, 19), "hh:mm") & vbCr & _
"@tt"

On Error GoTo debugs
Set Mail_Object = CreateObject("Outlook.Application")
Set Mail_Single = Mail_Object.CreateItem(0)
With Mail_Single
.Subject = Email_Subject
.To = Email_Send_To
.cc = Email_Cc
.BCC = Email_Bcc
.Body = Email_Body
.send
End With
debugs:
If Err.Description <> "" Then MsgBox Err.Description
'----------------------------------------------------------------
End If

Next
End If
End Sub
 
Re : Evenement et 2 condition?

Terminer naturellement tous les blocs entamés avant de passer au Case suivant: les End If des If et les Next des For. Le End Select devrait être la dernière instruction avant la End Sub. Si le travail à faire dans les deux cas est très semblable, plutôt que de l'écrire deux fois mettez le code dans une autre procédure, en lui passant éventuellement en paramètres les éléments qui dépendent des conditions, je pense notamment à TablCod(I), ainsi que Target.EntireRow ou mieux un tableau de ses valeurs Target.EntireRow.Resize(, 19).Value

Ou alors, ajoutez un Case Else: Exit Sub avant le End Select
 
Dernière édition:
Re : Evenement et 2 condition?

......plutôt que de l'écrire deux fois mettez le code dans une autre procédure, en lui passant éventuellement en paramètres les éléments qui dépendent des conditions, je pense notamment à TablCod(I), ainsi que Target.EntireRow ou mieux un tableau de ses valeurs Target.EntireRow.Resize(, 19).Value

Ou alors, ajoutez un Case Else: Exit Sub avant le End Select[/QUOTE]
Bonjour, je comprend pas trop cette fonction comment elle fonctionne!!
 
Re : Evenement et 2 condition?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim TablCode
Dim Email_Subject, Email_Send_From, Email_Send_To, _
Email_Cc, Email_Bcc, Email_Body As String
Dim Mail_Object, Mail_Single As Variant

TablCode = Array(31, 34, 36, 18, 99)
TablTargetColumns Array(21, 25, 29, 33)
TablNoemptyColumns Array(24, 28, 32, 36)

notEmpty = False
For Each c In TablNoemptyColumns
If Not IsEmpty(Target.Parent.Cells(Target.Row, c).Value) Then
notEmpty = True
Exit For
End If
Next
If InStr(Join(TablTargetColumns, " ") & " ", Target.Column & " ") > 0 And _
InStr(Join(TablCode, " ") & " ", Target.Value & " ") > 0 And _
notEmpty Then

'Macro email
'--------------------------------------------------------


Alors de cette manière la sa fonctionne à moitié, il faut que toutes les cases soit remplit alors que j'ai besoin de sa:
IF column 21 = 31 or 18 or 36 or 34 or 99 and Column 24 = not empty => send mail
IF column 25 = 31 or 18 or 36 or 34 or 99 and Column 28 = not empty => send mail
IF column 29 = 31 or 18 or 36 or 34 or 99 and Column 32 = not empty => send mail
IF column 33 = 31 or 18 or 36 or 34 or 99 and Column 36 = not empty => send mail
 
Re : Evenement et 2 condition?

Bonsoir.
Essayez comme ça :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cel1 As Range: Cel3 As Range, TablCode(), I&
If Target.Count > 1 Then Exit Sub
If Intersect(Me.[U:AG], Target) Is Nothing Then Exit Sub
Select Case (Target.Column - 21) Mod 3 + 1
   Case 1: Set Cel1 = Target: Set Cel3 = Target.Offset(, 2)
   Case 3: Set Cel1 = Target.Offset(, -2): Set Cel3 = Target
   Case Else: Exit Sub: End Select
If IsEmpty(Cel3.Value) Then Exit Sub
If IsError(WorksheetFunction.Match(Cel1.Value, Array(31, 34, 36, 18, 99), 0)) Then Exit Sub
'la suite est l'envoie d'un mail.
 
Re : Evenement et 2 condition?

bonjour
il y a une erreur dans la deuxieme ligne j'arrive pas à trouver laquelle
Dim Cel1 As Range: Cel3 As Range, TablCode(), I&

Sinon on m'a proposer cela ausi
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2. Dim TablCode
  3. Dim Email_Subject, Email_Send_From, Email_Send_To, _
  4. Email_Cc, Email_Bcc, Email_Body As String
  5. Dim Mail_Object, Mail_Single As Variant
  6. TablCode = Array(31, 34, 36, 18, 99)
  7. TablTargetColumns = Array(21, 25, 29, 33)
  8. TablNoemptyColumns = Array(24, 28, 32, 36)
  9. notEmpty = False
  10. For I = LBound(TablNoemptyColumns) To UBound(TablNoemptyColumns)
    [*] If Not IsEmpty(Target.Parent.Cells(Target.Row, TablNoemptyColumns(I)).Value) And _
    [*] Target.Parent.Cells(Target.Row, TablNoemptyColumns(I) - 2).Value <> "99A" Then
  11. OneOfValues = False
  12. For Each c In TablCode
  13. If c = Target.Parent.Cells(Target.Row, TablTargetColumns(I)).Value Then
    [*] Email_Subject = " DL " & TablCode(I)
  14. OneOfValues = True
  15. Exit For
  16. End If
  17. Next c
  18. If OneOfValues Then
  19. notEmpty = True
  20. Exit For
  21. End If
  22. End If
  23. Next
  24. If notEmpty Then

L'email bien envoyé selon les 4 condition mais le mail_subject n'ai pas respecté (exemple si je mets le code 31 dans le mail subject sil m'envoie automatiquement avec "DL 34" ....)
Et j'ai voulu ajouter une condition Si column 22 ou 26 ou 30 ou 34 = "99A -> ne pas envoyer de mail, j'ai ecrit la condition (voir italique) mais celle la ne fonctionne pas
 
Re : Evenement et 2 condition?

Bonjour

C'est une "," non ":" qu'il fallait, désolé.
Et pour la suite du code prendre Cel1.Value et Cel3.Value de préférence, bien évidemment.
S'il y a besoin de la cellule du milieu Cel1.Offset(, 1).Value
Et pour une cellule de la même ligne mais en dehors du paquet de 3, Target.EntireRow.Columns(x).Value
 
Re : Evenement et 2 condition?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cel1 As Range, Cel3 As Range, TablCode(), I&
If Target.Count > 1 Then Exit Sub
If Intersect(Me.[U:AG], Target) Is Nothing Then Exit Sub
Select Case (Target.Column - 21) Mod 3 + 1
Case 1: Set Cel1.Value = Target: Set Cel3.Value = Target.Offset(, 2)
Case 3: Set Cel1.Value = Target.Offset(, -2): Set Cel3.Value = Target
Case Else: Exit Sub: End Select
If IsEmpty(Cel3.Value) Then Exit Sub
If IsError(WorksheetFunction.Match(Cel1.Value, Array(31, 34, 36, 18, 99), 0)) Then Exit Sub

J'ai du mal a suivre; ou faut il mettre les cel1.value car sa me fait que des débogage 😕
 
Re : Evenement et 2 condition?

Quelle que soit celle changée en dernier, Cel1 c'est une cellule de la 1ère colonne d'un groupe de 3 et Cel3 en est une de la 3ième colonne de ce même groupe de 3. Il ne faudra donc plus prendre par la suite Target puisqu'on ne saura plus s'il correspondait à une cellule changée en dernier d'une colonne 1 ou d'une colonne 3 de son groupe de 3 colonnes.
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

Réponses
4
Affichages
548
Réponses
9
Affichages
476
Réponses
1
Affichages
446
Retour