Worksheet_change et deux condition?

Le 21/08/2015 à 09:33

Bonjour, j'ai actuellement une macro et j'aimerai rajouter une deuxième condition avant qu’elle se déclenche. la deuxieme condition serait If Target.Column = 23 Or Target.Column = 26 Or Target.Column = 29 Or Target.Column = 32 => <>""

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

'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 = "xxxx@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

Le 21/08/2015 à 09:53

Salut,

je ne comprends pas ça :

NICOPOF a écrit :

Or Target.Column = 32 => <>""

Pour rajouter une condition tu rajoutes avant le précédent IF, et tu rajoutes End If après la fin de l'autre procédure End IF.

Le 21/08/2015 à 09:53

Bonjour Nicopof, bonjour le forum,

Essaie avec Select Case... End Select à la place de IF... End IF :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim tablCode

If Target.Count > 1 Then Exit Sub
tablCode = Array(31, 34, 36, 18, 99)
Select Case Target.Column
    Case 21, 24, 27, 30
        For I = 0 To 4
            If Target.Value = tablCode(I) Then
                '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 = "xxxx@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
    Case 23, 26, 29, 32
        'ton code
End Select
End Sub

[Édition]

Bonjour Isa on s'est croisé...

Le 21/08/2015 à 10:14

si j'ai bie compris je doit mettre ma deuxième condition après la parti d'envoie de mail, a la fin?

Le 21/08/2015 à 10:15

Re,

Non, tu peux inverser l'ordre des Case et la mettre au début si tu veux... Mais ça ne changera rien puisqu'il s'agit de l'événement Change...

Le 21/08/2015 à 10:19
lsa039 a écrit :

Salut,

je ne comprends pas ça :

NICOPOF a écrit :

Or Target.Column = 32 => <>""

Pour rajouter une condition tu rajoutes avant le précédent IF, et tu rajoutes End If après la fin de l'autre procédure End IF.

en faite sa je l'ai rajouté ici, je veux envoyer un mail quand dans les colonne 21ou 24 ou 27 ou 30 un chiffre 99 ou 31 ou 18 ou36ou 34 apparait. et je voudrai mettre une deuxieme condition a cette envoie de mail. Il fait en plus d'un de ces chiffres, que la celulle suivante soit diffente de 99A et que la celulle d'apres soit pas vide ( donc <>"")

. End If

Next

Case 23, 26, 29, 32

If Target.Value <> "" Then

End Select

End Sub

désolé j'ai du mal a l'allimenté il arrête pas de mettre des message d'erreur ( end select sans select case) avec private sub qui s'affiche en jaune.

Le 21/08/2015 à 10:39

Recopie le code de ThauThème en entier, et ça fonctionnera

Le 21/08/2015 à 11:00

Alors je l'ai fait sa me met

erreur de compilation

End if sans bloc If

Le 21/08/2015 à 11:14

Re,

Oui en effet il y a un End If en trop :

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

If Target.Count > 1 Then Exit Sub
tablCode = Array(31, 34, 36, 18, 99)
Select Case Target.Column
    Case 21, 24, 27, 30
        For I = 0 To 4
            If Target.Value = tablCode(I) Then
                'Macro email
                '--------------------------------------------------------
                If OutlookOuvert = False Then o = Shell("Outlook", vbNormalNoFocus)
                Email_Subject = " DL " & tablCode(I)
                Email_Send_From = "xxxx@gmail.com"
                Email_Send_To = "xxxx@gmail.com"
                Email_Cc = "xxxx@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
    Case 23, 26, 29, 32
        'ton code
End Select
End Sub
Le 21/08/2015 à 11:35

A nikel

Donc a la place de ton code je mets If target.Value <> "" Then

Le 21/08/2015 à 12:17

Re,

Heu !... J'en sais rien, c'est toi qui fait le code !... Si tu expliques clairement ce que tu veux que la macro exécute je pourrais peut-être te répondre.

Le 21/08/2015 à 12:44

Je t'ai joint le Fichier pour que tu comprennes mieux:

- Je veux envoyer un mail auto quand un code 31 ou 36 ou 18 ou 34 ou 99 est ajouter dans la colonne code ( la 21 ou 25 ou 29 ou 32 ou 36)

(jusque la sa fonctionne nickel)

- J'aimerai rajouté deux condition:

- la premier quand par exemple un agent marque le code 31, le mail doit partir seulement quand la case explication est remplir

- la deuxième et dernière condition pour que ce soit nickel; si un code 99 est mit et que dans la case sous code est mit 99A ne rien faire, ne pas envoyer le mail

la deuxième condition si ce n'est pas possible ce n'est pas grave

Voila ce que j'essaie de faire!!!

Merci

13test-vba.xlsm (275.27 Ko)
Le 21/08/2015 à 17:31

Re,

Voilà, j'ai rajouté deux lignes après le Case. Pour la première pas de problème, si code 31 et explications vide la procédure s'arrête. La seconde, en revanche, pour empêcher l'envoie de l'email il faudra commencer par écrire 99A en dessous pour que ça marche !... Donc je pense complètement inefficace dans ton cas.

Case 21, 25, 29, 33
        If Target.Value = 31 And Target.Offset(0, 3).Value = "" Then Exit Sub
        If Target.Value = 99 And Target.Offset(1, 0) = "99A" Then Exit Sub
Le 22/08/2015 à 00:58

Alors je viens de test, soit le mail ne part pas du tout, soit il part mais sans que la deuxième condition soit validé c'est a dire explication <>"".

En faite j'aimerai que le mail a condition que la case explication soit remplie pour alimenter l'email body. Si le mail part sans que le case explication soit rempli, dans le mail l'explication sera vide.

Donc soit je positionne mal ( je l'ai ajouter en haut en dessous du premier case) mais en bas en end sa bug (erreur de compilation)

j'ai remarqué que si je met le 31 et ensuite je marque case explication le mail ne partait plus comme si la casse explication devais être rempli au même moment !!!

en revanche si la case explication est rempli alors le mail part mais bon je peut pas inverser les colonne car sa n'aurai plus de sens dans le travaille

dur dur =)

Le 22/08/2015 à 14:04

Bonjour,

Ton problème est dû au fait que tu utilises une macro événementielle alors qu'il te faudrait une macro sur ordre (un bouton).

Je m'explique :

Pour la première condition :

• Tu tapes 31 dans une des colonnes (21, 25, 29, ou 33)

• Le code est lancé puisque tu as édité dans une des colonnes, on va dire : ACTIVE

• Il vérifie trois colonnes à coté et tu n'as pas encore écrit les explications donc l'email ne part pas (normal)

• Tu écris les explications

• Comme tu modifies trois colonnes à coté du code se sera forcément la colonne 24, 28, 32 ou 36

• Mais là, ce n'est plus une colonne ACTIVE donc le code n'est plus lancé.

Pour la seconde condition c'est différent mais ça me marche pas non lus

• Tu tapes 99 dans une des colonnes (21, 25, 29, ou 33)

• Le code est lancé puisque tu as édité dans une des colonnes ACTIVE

• Il vérifie un ligne en-dessous et tu n'as pas encore écrit 99A donc l'email part

• Tu écris 99A pour empêcher l'email de partir mais c'est déjà trop tard

Dans les deux cas, si tu veux que ça fonctionne il faut écrire les explications ou 99A AVANT d'écrire le code !

L'autre solution, à mon avis plus fiable, un bouton dans lequel tu appuis quand tu as fini d'éditer. Il vérifie alors les conditions et agit en fonction...

Le 22/08/2015 à 14:11

Ok je vois ce que tu veux dire

En tout cas je te remercie je vais essayer d’étudier la question

Rechercher des sujets similaires à "worksheet change deux condition"