Selectionne les contacts voulu via la liste déroulante

Le 02/06/2021 à 15:13

Bonjour,

J'ai un code qui me permet d'envoyer un mail prêt rempli avec divers option voulu. Mais le sujet est que j'aimerai via ma liste déroulant sélectionner les contacts qui y sont incrémentés. J'aimerai sélectionner la liste déroulante de la cellule J17 de la feuille "Demande d'intervention", puis via celle-ci faire appel aux destinataires concernés

Quelqu'un à une idée ?

J'ai créé une variable "strContactTo As String" sur mon code VBA qui actionne les fonctions pour la création du mail, puis l’incrémente dans ".To = strContactTo" pour les destinataires voulu du mail.

Option Explicit
Public Sub Bouton_unique_DI()

Dim ws As Worksheet, ws2 As Worksheet
Dim OutApp As Object, OutMail As Object, WshShell As Object
Dim sNomFic As String, sRep As String, strContactTo As String
Dim i As Long

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With

'Appel à déprotéger le fichier complet
    Call Dprotection

'Sauvegarde du formulaire DI sur l'onglet "Sauvegarde DI"
    Set ws = Worksheets("Sauvegarde_DI")
    Set ws2 = Worksheets("Demande_d'Intervention")

    i = 5
    Do While ws.Range("D" & i).Value <> ""
        i = i + 1
    Loop

    ws.Range("E" & i).Value = ws2.Range("J17").Value
    ws.Range("D" & i).Value = ws2.Range("J19").Value
    ws.Range("I" & i).Value = ws2.Range("J21").Value
    ws.Range("F" & i).Value = ws2.Range("I24").Value
    ws.Range("G" & i).Value = ws2.Range("M24").Value
    ws.Range("H" & i).Value = ws2.Range("G27").Value
    ws.Range("K" & i).Value = ws2.Range("I45").Value
    ws.Range("M" & i).Value = ws2.Range("L45").Value
    ws.Range("L" & i).Value = ws2.Range("I47").Value
    ws.Range("J" & i).Value = ws2.Range("M49").Value

'Mise en forme du formulaire dans le mail
    Set WshShell = CreateObject("WScript.Shell")
    sRep = WshShell.SpecialFolders("Desktop")

    sNomFic = sRep & "Demande d'intervention " & Replace(ws2.Range("J19").Value, "/", "-") & ".pdf"

    ws2.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=sNomFic, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=False

    Set OutApp = CreateObject("outlook.application")
    Set OutMail = OutApp.CreateItem(0)

    With OutMail
        .To = strContactTo
        .Cc = ""
        .Attachments.Add sNomFic
        .Subject = "Demande d'intervention " & Replace(ws2.Range("J19").Value, "/", "/")
        .Body = "Bonjour" & Chr(13) & Chr(13) & "Ci-joint, la demande d'intervention au format PDF."
        .Display
'        .Send 'envoi du mail

    End With

    Kill sNomFic

'Efface les cellules concernées
    Range("J17:L17,J19:K19,J21,G27:N41,L45:M45,I47:K47").ClearContents
    ActiveWorkbook.Save

    Set WshShell = Nothing: Set OutApp = Nothing: Set OutMail = Nothing

'Appel à la protection du fichier
    Call Protection

'Sauvegarde le fichier après exécution du code
    ActiveWorkbook.Save

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
    End With

'Message de fin pour cloturer le programme
MsgBox "Demande d'intervention expédiée à la liste de diffusion concernée"

End Sub

Mais pour le code pour la liste déroulante, la j'ai plus de mal. j'ai commencé mais je me perd dans le procédé.

Option Explicit
Sub Contacts()

Dim i As Long
Dim tabContactEmails

'Selectionne les contacts via la liste déroulante
With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With

' Récupérer les mails des destinataires
    Sheets("Paramètres").Activate

'les adresses mail CA sont en colonne E
    Set début_liste = Range("E4")
    Set fin_liste = Range("E4").End(xlDown)
    MailAd_CA = Range(début_liste, fin_liste).Value

'les adresses mail SVH sont en colonne G
    Set début_liste = Range("G4")
    Set fin_liste = Range("G4").End(xlDown)
    MailAd_SVH = Range(début_liste, fin_liste).Value

'les adresses mail LH sont en colonne I
    Set début_liste = Range("I4")
    Set fin_liste = Range("I4").End(xlDown)
    MailAd_LH = Range(début_liste, fin_liste).Value

'les adresses mail GRA sont en colonne K
    Set début_liste = Range("K4")
    Set fin_liste = Range("K4").End(xlDown)
    MailAd_GRA = Range(début_liste, fin_liste).Value

 With Application
        .EnableEvents = True
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
    End With

End Sub

Merci à vous

22false1.xlsm (93.45 Ko)
Le 02/06/2021 à 23:22

bonjour,

95 messages et pas encore compris que pour citer du code on utilisait le bouton </> ?

Les bras m'en tombent !

EDIT : De plus joindre un classeur complètement vide est à peu près aussi utile que de ne rien joindre du tout : Tu perds ton temps et tu nous fais perdre le notre.

A défaut d'un vrai classeur on demande un classeur qui permet de tester et de comprendre. après le nom réel réel du mec ou son N° de téléphone on s'en fout. Mais si en plus on doit imaginer ce qu'on pourrait bien faire avec ce genre de classeur : Moi c'est pas compliqué, je referme et je vais me coucher !

A+

Le 03/06/2021 à 07:57
10false2.xlsm (110.89 Ko)

Bonjour,

Désolé de ne pas être très performant au sujet du VBA mais ce n'ai vraiment pas mon domaine de prédilection.

Ci-joint mon classeur plus détaillé.

Le 03/06/2021 à 08:32

En fait c'est moi qui ne devait plus être bien réveillé...

Bon de toute façon il ne me semble pas possible de sélectionner plusieurs destinataires sur cette cellule :

Soit tu utilises des listes et tu coches chaque ligne ou il y a un nom pertinent.

Soit tu crées une ou plusieurs macros qui sont capables de reconnaitre des groupes de noms.

Mais pour ce genre de liste de validation ça sert juste à vérifier que le nom saisi est orthographié correctement... Tu ne peux pas sélection plusieurs items via une liste de validation.

A+

Le 03/06/2021 à 11:51

Re,

Pas grave, et j'ai réussi en fouinant à trouver mon bonheur en incrémentant un nouveau module ci-dessous

Function Contacts2(xDest)
    With Sheets("Paramètres")
        xListeAdresse = Range("Tab_Mail_" & xDest)
    End With
    Contacts2 = xListeAdresse
End Function

Puis en modifiant un partie de mon code en appelant les fonction du dessus

    xListeTo = Contacts2([J17])
    For F = 1 To UBound(xListeTo)
        If F = 1 Then
            strContactTo = xListeTo(F, 1)
        Else
            strContactTo = strContactTo & ";" & xListeTo(F, 1)
        End If
    Next F

Merci quand même de ton aide

Rechercher des sujets similaires à "selectionne contacts voulu via liste deroulante"