Combiner deux codes VBA - Private Sub Worksheet_Change(ByVal Target As Rang

Version imprimable

03/04/2022, 23h08
pryamani

1 pièce(s) jointe(s)

Combiner deux codes VBA - Private Sub Worksheet_Change(ByVal Target As Rang

Bonjour,

Je viens vous sollicter car je n'arrive pas à combiner deux codes VBA dans une Worsheet_Change.

Pouvez-vous s'il vous plaît m'aider ? J'ai une macro qui me permet d'envoyer un mail automatique dès lors qu'une date est renseignée en colonne "AG intitulée Notice validée sur ARES le".

Je souhaiterai qu'il en soit de même si je renseigne également une date en colonne ""W" intitulée Dossier reçu complet". Le message du mail est différent. Je n'arrive pas à utiliser le else if comme il se doit.

En vous remerciant par avance

Cordialement
Prya

Bonjour,

Comme ceci:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
    If Not Intersect(Target, Range("W8:W643,AG8:AG643")) Is Nothing Then
        If IsDate(Target) Then
             If Target.Column = 33 Then 'Colonne AG" colonne date de mise en paie
                 Target.Offset(0, 1) = IIf(IsDate(Target), "Payé", "Non payé")  'target = cible correspond à la cellule sur laquelle tu as cliqué. Target.offset(0,1) correspond à la cellule à droite (une colonne à droite= 1), sur la même ligne (0) de la cellule sur laquelle tu as cliqué
                 'conversion fichier en pièce jointe
                 Set OutApp = CreateObject("Outlook.Application")
                 OutApp.Session.Logon
                 Set OutMail = OutApp.CreateItem(0)
                 strbody = "<font face=calibri>" & "<font size=4>" & "Madame, Monsieur," & "<br>" & "<br>" & "Suite à la validation de votre contrat de travail par le service des ressources humaines et de la réception de l'attestation de service fait, je vous informe que les heures que vous avez effectuées au semestre 1 et/ou 2 ont été mises en paiement." & Chr(10) & Chr(10) & "Pour plus de précisions sur le mois de paiement merci de bien vouloir s'il vous plaît vous connecter sur l'Application de Recensement des Enseignements et Services - ARES - https://ares.univ-amu.fr/Ares/." & "<br>" & "<br>" & " Ci-joint un petit tutoriel." & "<br>" & "<br>" & "Pour information : les montants sont exprimés en BRUT. Un délai de deux mois est à prévoir pour un paiement effectif." & "<br>" & "<br>" & "Bien Cordialement" & _
                           "<br>" & "<br>" & "votre gestionnaire RH - HC"    'Ici le texte du mail
            ElseIf Target.Column = 23 Then 'Colonne W" colonne dossier reçu
                 'conversion fichier en pièce jointe
                 Set OutApp = CreateObject("Outlook.Application")
                 OutApp.Session.Logon
                 Set OutMail = OutApp.CreateItem(0)
                 strbody = "<font face=calibri>" & "<font size=4>" & "Madame, Monsieur," & "<br>" & "<br>" & "Suite à la réception de votre dossier de recrutement 2022-2023, je vous informe que ce dernier a été traité sur ARES, je vous invite à vous connecter sur cette application pour suivre l'avancée de votre dossier et me faire part de toutes anomalies rencontrées." & Chr(10) & Chr(10) & "Je vous rapelle que les enseignements effectués au delà de 64HETD font l'objet d'une étude par le conseil académique de l'université qui se réunit une fois par mois, date du conseil mentionnée sur ARES" & "<br>" & "<br>" & " Je ne manquerai pas de revenir vers vous uniquement par mail pour vous transmettre votre contrat de travail à me retourner signé." & "<br>" & "<br>" & "Cordialement" & _
                           "<br>" & "<br>" & "votre gestionnaire RH - HC"    'Ici le texte du mail
 
            End If
                 '---------------------------------------------------------
            Set lemail = CreateObject("Outlook.Application")
            With lemail.CreateItem(olMailItem)
                .To = Range("J" & Target.Row).Value
                .Subject = "2022-2023 Mise en paiement des heures effectuées" ' l'objet du mail
                .HTMLBody = strbody & .HTMLBody
                .Attachments.Add "C:\Users\Alexandra\Desktop\Dématérialisation et accessibilité des bulletins de salaire.pdf"
                .Attachments.Add "C:\Users\Alexandra\Desktop\Navigation ARES.pdf"
                .Display   'préparer le mail avant de l'envoyer
                .Send
            End With
            '
            Set lemail = Nothing ' Destruction de l'objet application
            ActiveWorkbook.Save
        End If
    End If

A noter: Convertissez votre tableau en tableau structuré en ne prenant que les lignes utilisées réellement, ainsi à chaque ajout d'une ligne supplémentaire les formules seront recopiées automatiquement et la taille de votre tableau sera calculé au plus juste.

voir ici: https://fauconnier.developpez.com/tu...ux-structures/

Cdlt

04/04/2022, 23h26
pryamani

Merci beaucoup ARTURO83 !

J'ai pris bonne note pour le tableau structuré.

Cordialement
Prya
17/05/2022, 23h34
pryamani

1 pièce(s) jointe(s)

Bonjour,

Pouvez-vous SVP me dire comment je peux adapter le code ci-dessous

Pièce jointe 619317

Je souhaiterai que si je renseigne une date en colonne 23 "W" intitulée Dossier reçu complet". je puisse rectifier l'objet du mail "Accusé de réception de votre dossier de recrutement" et supprimer les PJ pour cet envoi uniquement et

si je renseigne une date en colonne 33 "AG", l'ojet du mail change (2022-2023 Mise en paiement des heures effectuées) et les PJ doivent être envoyées.

En vous remerciant par avance
Cordialement Prya

Bonjour,

Essayez ceci, si c'est la date est saisie en colonne W, il vous sera demandé de saisir l'objet via une boîte de dialogue et les pièces jointes seront supprimées, si la date est en colonne AG, tout reste comme avant.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
    If Not Intersect(Target, Range("W8:W643,AG8:AG643")) Is Nothing Then
        If IsDate(Target) Then
            '************* si c'est la colonne AG qui est sélectionnée *****************************
             If Target.Column = 33 Then 'Colonne AG" colonne date de mise en paie
                 Target.Offset(0, 1) = IIf(IsDate(Target), "Payé", "Non payé")  'target = cible correspond à la cellule sur laquelle tu as cliqué. Target.offset(0,1) correspond à la cellule à droite (une colonne à droite= 1), sur la même ligne (0) de la cellule sur laquelle tu as cliqué
                 'conversion fichier en pièce jointe
                 Set OutApp = CreateObject("Outlook.Application")
                 OutApp.Session.Logon
                 Set OutMail = OutApp.CreateItem(0)
                 strbody = "<font face=calibri>" & "<font size=4>" & "Madame, Monsieur," & "<br>" & "<br>" & "Suite à la validation de votre contrat de travail par le service des ressources humaines et de la réception de l'attestation de service fait, je vous informe que les heures que vous avez effectuées au semestre 1 et/ou 2 ont été mises en paiement." & Chr(10) & Chr(10) & "Pour plus de précisions sur le mois de paiement merci de bien vouloir s'il vous plaît vous connecter sur l'Application de Recensement des Enseignements et Services - ARES - https://ares.univ-amu.fr/Ares/." & "<br>" & "<br>" & " Ci-joint un petit tutoriel." & "<br>" & "<br>" & "Pour information : les montants sont exprimés en BRUT. Un délai de deux mois est à prévoir pour un paiement effectif." & "<br>" & "<br>" & "Bien Cordialement" & _
                           "<br>" & "<br>" & "votre gestionnaire RH - HC"    'Ici le texte du mail
                  '---------------------------------------------------------
                Set lemail = CreateObject("Outlook.Application")
                With lemail.CreateItem(olMailItem)
                    .To = Range("J" & Target.Row).Value
                    .Subject = "2022-2023 Mise en paiement des heures effectuées" ' l'objet du mail
                    .HTMLBody = strbody & .HTMLBody
                    .Attachments.Add "C:\Users\Alexandra\Desktop\Dématérialisation et accessibilité des bulletins de salaire.pdf"
                    .Attachments.Add "C:\Users\Alexandra\Desktop\Navigation ARES.pdf"
                    .Display   'préparer le mail avant de l'envoyer
                    .Send
                End With
 
'********************************************************************************************************************************
            '************* Si c'est la colonne 23 qui est sélectionnée ***********************************
            ElseIf Target.Column = 23 Then 'Colonne W" colonne dossier reçu
                Objet = InputBox("Saisir l'objet du mail", "Objet du mail")
 
                'conversion fichier en pièce jointe
                Set OutApp = CreateObject("Outlook.Application")
                OutApp.Session.Logon
                Set OutMail = OutApp.CreateItem(0)
                strbody = "<font face=calibri>" & "<font size=4>" & "Madame, Monsieur," & "<br>" & "<br>" & "Suite à la réception de votre dossier de recrutement 2022-2023, je vous informe que ce dernier a été traité sur ARES, je vous invite à vous connecter sur cette application pour suivre l'avancée de votre dossier et me faire part de toutes anomalies rencontrées." & Chr(10) & Chr(10) & "Je vous rapelle que les enseignements effectués au delà de 64HETD font l'objet d'une étude par le conseil académique de l'université qui se réunit une fois par mois, date du conseil mentionnée sur ARES" & "<br>" & "<br>" & " Je ne manquerai pas de revenir vers vous uniquement par mail pour vous transmettre votre contrat de travail à me retourner signé." & "<br>" & "<br>" & "Cordialement" & _
                          "<br>" & "<br>" & "votre gestionnaire RH - HC"    'Ici le texte du mail
 
                  '---------------------------------------------------------
                Set lemail = CreateObject("Outlook.Application")
                With lemail.CreateItem(olMailItem)
                    .To = Range("J" & Target.Row).Value
                    .Subject = Objet ' l'objet du mail
                    .HTMLBody = strbody & .HTMLBody
                    .Display   'préparer le mail avant de l'envoyer
                    .Send
                End With
            End If
            '
            Set lemail = Nothing ' Destruction de l'objet application
            ActiveWorkbook.Save
        End If
    End If

Cdlt

18/05/2022, 10h00
pryamani

Bonjour Artur083,

Je vous remercie infiniment pour votre retour.

J'étais sur la bonne piste mais ne connaissais pas encore le msg box. Je cherchais la solution depuis deux semaines.

En vous remerciant encore pour cette aide.

cordialement
Prya