Microsoft 365 Transcription formule en VBA

guenfood · 24 Mai 2022

Bonjour à toutes et à tous,
Afin de générer la création de mails en fonction de valeurs de différentes cellules, j'ai créé une formule avec plusieurs conditions.
Le hic, c'est que le LIEN_HYPERTEXTE est limité à 255 caractères et donc, je me retrouve régulièrement avec des #VALEUR en résultat
Je souhaiterais donc retranscrire cette formule en macro, mais vu le nombre de conditions, je coince.

Je vous retranscris la formule en question.

Code:

=SI(D16="";"";SI(D19="DW";LIEN_HYPERTEXTE("mailto:"&Reference!G5;Reference!G5);LIEN_HYPERTEXTE("mailto:"&RECHERCHEV(D16;Groupes!A$2:B$601;2;FAUX);RECHERCHEV(D16;Groupes!A$2:B$601;2;FAUX)&"&subject="&Formulaire!D21&" Suivi "&Formulaire!D7&"n° "&Formulaire!D4&"&body="&SI(Formulaire!D21="Mail1";Mail1!A1&Mail1!A2&Mail1!A3&Mail1!A4&Mail1!A5&Mail1!A6&Mail1!A7&Mail1!A8&Mail1!A9&Mail1!A10;Mail-relance!A1&Mail-relance!A2)&"&cc="&SI(D19="DW";Reference!H5&Reference!F6;SI(D19="IEC";Reference!F1&Reference!F6;SI(D19="FCR";Reference!F2&Reference!F6;SI(D19="MDP";Reference!F3&Reference!F6;SI(D19="RCR";Reference!F4;"")))))

Un grand merci par avance pour votre aide.

AtTheOne · 24 Mai 2022

Bonsoir à toutes & à tous, bonsoir @guenfood
J'ai du jouer les Champollion avec ta formule :

Tout d'abord
=SI(D16="";"";... est-ce bien D16 et non D19 comme dans la suite de ta formule ? (j'ai gardé D16)
Puis
... LIEN_HYPERTEXTE("mailto:"&Reference!G5;Reference!G5) ;... pas d'objet, pas de corps de mail ? Juste ce que je suppose être une adresse ...
Ensuite
...LIEN_HYPERTEXTE("mailto:"&RECHERCHEV(D16;Groupes!A$2:B$601;2;FAUX);RECHERCHEV(D16;Groupes!A$2:B$601;2;FAUX)&"&subject=... la syntaxe est erronée ce serait plutôt :
LIEN_HYPERTEXTE("mailto:"&RECHERCHEV(D16;Groupes!A$2:B$601;2;FAUX)&"&subject= ... ;RECHERCHEV(D16;Groupes!A$2:B$601;2;FAUX))
En dernier
&cc="&SI(D19="DW";Reference!H5&Reference!F6; Pas au bon endroit car là où c'est placé D19 est différent de "DW". Cette partie est à placer dans la 1ère fonction LIEN_HYPERTEXTE puisqu'elle correspond au cas D19="DW"

Avec ce que j'ai compris je te propose une macro que je n'ai pas pu tester faute de fichier exemple :

Enrichi (BBcode):

Sub Envoi_Courriel()

     Dim WSh As Worksheet, OutlookApp As Object, OutlookMail As Object, MTo$, CC$, BCC$, Subject$, Body$, Attachment$, WFct As WorksheetFunction

     Set WSh = ActiveSheet  'remplacer Activesheet par la feuille qui contient les références D16, D19
     Set WFct = Application.WorksheetFunction
     
With WSh
          If .[D16] = "" Then Exit Sub    'Vérifier que c'est bien D16 qu'il faut prendre
          If .[D19] = "DW" Then
               With Worksheet("Reference")
                    MTo = .[G5]           'Adresse
                    CC = .[H5] & .[F6]    'Copie conforme
               End With
          Else
               MTo = WFct.VLookup(WSh.[D16], Worksheets("Groupes").[A2:B601], 2, False)    'Adresse
               With Worksheets("Formulaire")
                    Subject = .[D21] & " Suivi " & [D7] & " n° " & .[D4]       'Objet
               End With
               If Worksheets("Formulaire").[D21] = "Mail1" Then
                    With Worksheets("Mail1")
                         Body = .[A1] & .[A2] & .[A3] & .[A4] & .[A5] & .[A6] & .[A7] & .[A8] & .[A9] & .[A10]  'Texte du mail cas "Mail1"
                    End With
               Else
                    With Worksheets("Mail-relance")
                         Body = .[A1] & .[A2]     'Texte du mail autres cas
                    End With
               End If
               'Copie conforme cas autre que DW (traité plus haut)
               With Worksheet("Reference")
                    Select Case WSh.[D19]
                         Case "IEC"
                              CC = .[F1] & .[F6]
                         Case "FCR"
                               CC = .[F2] & .[F6]
                         Case "MDP"
                              CC = .[F3] & .[F6]
                         Case "RCR"
                              CC = .[F4]
                         Case Else
                              CC = ""
                    End Select
               End With
          End If
     End With
    
    'Création d'une instance d'OUTLOOK
     Set OutlookApp = CreateObject("Outlook.Application")
     'Création d'un mail
     Set OutlookMail = OutlookApp.CreateItem(0)
     With OutlookMail
          .To = MTo                           'Destinataire
          .CC = CC                            'Copie conforme
          .BCC = BCC                          'Copie cachée
          .Subject = Subject                  'Objet
          .Body = Body                        'Corps du mail
          If Attachments <> "" Then .Attachments.Add Filename  'Pièce jointe (faire une boucle si plusieurs PJ)
          .Display                            'à remplacer par .Send  pour un envoi immédiat
     End With

End Sub

Bon courage, merci de me tenir informé
Amicalement
Alain

Microsoft 365 Transcription formule en VBA

guenfood

XLDnaute Occasionnel

AtTheOne

XLDnaute Accro

Discussions similaires