Microsoft 365 envoie par mail en fonction Combobox

jeromeN95

jeromeN95

XLDnaute Impliqué
Bonsoir,
j'aimerai envoyer par mail 1 ou plusieurs (jusqu'à 5) feuilles (30 onglets) en fonction d'un choix de ComboBox.
J'ai crée un tableau de correspondance.
J'arrive à alimenter les 5 Combobox

J'arrive à envoyer par mail.

Je n'arrive pas à modifier ce code pour lui faire comprendre d'envoyer seulement les onglets (feuilles) sélectionner dans les combobox (de 1 à 5).

VB: 
Option Explicit

Public Sub env_Proto() 'Envoie le ou les protocoles par mail
Dim omg As Object
Dim msg As String
Dim tcl As Long
Dim fic As String
    On Error GoTo fin

    Sheets("ComboBoxi").Visible = True 'affiche l'onglet en fonction de la selection  car caché à l'ouverture du fichier
    fic = ThisWorkbook.Path & "\Protocole d'utilisation des produits.pdf"      'nom voulu pour le correspondant
  
    If Dir(fic) <> "" Then Kill fic    'on crée le fichier PDF dans le même dossier que le fichier source
    Sheets("ComboBoxi").ExportAsFixedFormat Type:=xlTypePDF, Filename:=fic _
                , Quality:=xlQualityStandard, IncludeDocProperties:=True, _
                IgnorePrintAreas:=False, OpenAfterPublish:=False
    Set omg = CreateObject("CDO.Message")
    With omg
        .Subject = "Protocole d'utilisation des produits"        'sujet
        .From = "jer@fournisseur.fr"      ' adresse mail de l'expéditeur
        .To = [A25].Value              ' Email du destinataire
       ' .CC = [A5].Value                 'vendeur en copie
        .TextBody = "Bonjour, veuillez trouver ci-joint le(s) protocole(s) d'utilisation de nos produits. Bien à vous, La Sociétée"
        With .Configuration.Fields
            .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.orange.fr"
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
            .Update
        End With
        .AddAttachment (fic)
        .Send
    End With
    Kill fic    'après l'envoi la feuille PDF est supprimée
      
      
        Sheets("ComboBoxi").Visible = False 're-masque l'onglet

fin:       ' si erreur on sort de la procédure : description de l'erreur survenue
If Err.Number <> 0 Then MsgBox "Anomalie détectée" & vbLf & vbLf & Err.Description

   Unload Protocole 'ferme l'Userform de séléction des protocoles

End Sub
 

Pièces jointes

  • Combobox choix.xlsm
    104.2 KB · Affichages: 9
Trier par date Trier par votes
jeromeN95

jeromeN95

XLDnaute Impliqué
Super, ca fonctionne.
J'ai juste 1 question :

j'aimerai que dans le combobox unique, je n'ai accés qu'à certaine feuilles en particulier.


Toutes sauf celle qui se nome "Choix" et "Contrat" et "Régles" par exemple.
Car j'ai 36 feuilles quand même.


Juste me dire comment modifier ce petit bout de code :

VB: 
    Sheets(Split(Trim(Replace(texte, "|", " ")), " ")).Select
 
Dernière édition:
Vote positif 0 Vote négatif
Dranreb

Dranreb

XLDnaute Barbatruc
Bonsoir.
jeromeN95 à dit:
Juste me dire comment modifier ce petit bout de code :
Cliquez pour agrandir...
Vous pouvez le décomposer par exemple :
VB: 
Dim TNomsFeui() As String
TNomsFeui = Split(Trim(Replace(texte, "|", " ")), " ")
Sheets(TNomsFeui).Select
Mais je pense que vous devriez vous arranger pour obtenir ce tableau TNomsFeui d'une autre manière plus adaptée à votre contexte.
Dans les classeur que vous aviez joint vos noms de feuilles étaient des numéros qui n'avaient rien à voir avec les textes proposés dans les ComboBox mais qui pouvaient s'obtenir par l'expression 6 * C + CBx.ListIndex - 5, CBx étant déclaré As MSForms.ComboBox et initialisé par Set CBx = Me("ComboBox" & C) dans une boucle For C = 1 To 5

En fait puisque, bien que je ne comprends absolument pas comment ça peut marcher avec ActiveSheet.ExportAsFixedFormat, il se trouve que ça marche, on n'a plus besoin du tout de transmettre de paramètre à la Sub EnvoiProto. Si vous souhaitez toujours que l'export en PDF et l'envoi du mail soit dans cette procédure séparée plutôt que dans l'UserForm, voici le code de ce dernier :
VB: 
Option Explicit
Private Sub UserForm_Initialize()
   ComboBox1.List = Range("DETARTRAGE").Value
   ComboBox2.List = Range("FOUR").Value
   ComboBox3.List = Range("RENOVATION").Value
   ComboBox4.List = Range("LEGUMERIE").Value
   ComboBox5.List = Range("TREMPAGE").Value
   End Sub
Private Sub CommandButton1_Click()
   Dim TNomsFeui() As String, C As Long, CBx As MSForms.ComboBox, NomFeui As String, N As Long
   ReDim TNomsFeui(1 To 5)
   For C = 1 To 5
      Set CBx = Me("ComboBox" & C)
      If CBx.MatchFound Then
         NomFeui = 6 * C + CBx.ListIndex - 5
         N = N + 1: TNomsFeui(N) = NomFeui: End If
      Next C
   If N = 0 Then Exit Sub
   ReDim Preserve TNomsFeui(1 To N)
   Me.Hide
   Sheets(TNomsFeui).Select
   EnvoiProto
   Unload Me
   End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
jeromeN95

jeromeN95

XLDnaute Impliqué
Non non, ce n’est pas encore terminé.
Mais ça y est presque.
Je pense que d’ici ce soir, il me faudra moins d’une heure pour complètement mettre résolu.
Étant donné que je vais garder votre bout de code, il faut que je rajoute la fonction de conversion entre le numéro de l’anglais et le nom à afficher.
Pour le moment, je n’ai pas exactement compris.
 
Vote positif 0 Vote négatif
Dranreb

Dranreb

XLDnaute Barbatruc
Si vous n'avez plus qu'une ComboBox, le numéro de l'onglet c'est tout simplement ComboBox1.Listindex + 1. Attention: c'est numérique et ça ne peut pas être utilisé comme nom d'onglet. Veillez à ce que ce soit bien converti en String quelque part.
Il serait aussi possible de faire tout ça avec deux ListBox, une pour les Disponibles et une pour les À envoyer. Le mieux serait d'y afficher la désignation ET le nom d'onglet.
 
Vote positif 0 Vote négatif
jeromeN95

jeromeN95

XLDnaute Impliqué
oula, je mélange tout :
ca ne fonctionne plus.

Alors l'onglet avec le nom par catégorie c'est RéglesProto
composer des listes B3:B8 liste combobox1 (détartrage)
B9:B14 : combobox2 (Four)
...
...

Dans la colonne D c'est les 5 feuilles possible (par combo donc)
et en colonne F c'est le numéro de l'onglet :



VB: 
Option Explicit

Private Sub UserForm_Initialize()
   ComboBox1.List = Range("DETARTRAGE").Value
'   ComboBox2.List = Range("FOUR").Value
'   ComboBox3.List = Range("RENOVATION").Value
'   ComboBox4.List = Range("LEGUMERIE").Value
'   ComboBox5.List = Range("TREMPAGE").Value
   End Sub
  
'Dim texte
Private Sub cbx_Change()
    If cbx.ListIndex > -1 Then
        If Not texte Like "*" & cbx.Value & "*" Then texte = texte & cbx.Value & "|"
        cbx.ListIndex = -1
    End If
    TextBox1 = Replace(texte, "|", vbCrLf)
End Sub

Private Sub cbx_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If Button = 2 Then texte = "": cbx.ListIndex = -1: Exit Sub
End Sub

Private Sub CommandButton1_Click()
Dim Chemin As String
Dim omg As Object
Dim msg As String
Dim tcl As Long
Dim fic As String
Dim TNomsFeuil() As String

    On Error GoTo fin
    
    
    
     Dim TNomsFeui() As String, C As Long, cbx As MSForms.ComboBox, NomFeui As String, N As Long
   ReDim TNomsFeui(1 To 5)
   For C = 1 To 5
      Set cbx = Me("ComboBox" & C)
      If cbx.MatchFound Then
         NomFeui = 6 * C + cbx.ListIndex - 5
         N = N + 1: TNomsFeui(N) = NomFeui: End If
      Next C
   If N = 0 Then Exit Sub
   ReDim Preserve TNomsFeui(1 To N)
   Me.Hide
   Sheets(TNomsFeui).Select
  
    
    
    
    
    
        If texte = "" Then Exit Sub
        
 Chemin = ThisWorkbook.Path & "\Protocols.pdf"



    'Sheets(Split(Trim(Replace(texte, "|", " ")), " ")).Select
    TNomsFeuil = Split(Trim(Replace(texte, "|", " ")), " ")
    Sheets(TNomsFeuil).Select
    


    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                                    Chemin, Quality:=xlQualityStandard, _
                                    IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
                                    False
                                    
                                    
                                    
                    ' ENVOYER PAR MAIL
     fic = ThisWorkbook.Path & "\Protocols.pdf"      'nom du fichier crée précédement

    Set omg = CreateObject("CDO.Message")
    With omg
        .Subject = "Protocole d'utilisation des produits"        'sujet
        .From = "jer@fournisseur.fr"      ' adresse mail de l'expéditeur
        .To = "jerome-prevost@hotmail.fr"   '[A25].Value              ' Email du destinataire
       ' .CC = [A5].Value                 'vendeur en copie
        .TextBody = "Bonjour, veuillez trouver ci-joint le(s) protocole(s) d'utilisation de nos produits. Bien à vous, La Sociétée"
        With .Configuration.Fields
            .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.orange.fr"
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
            .Update
        End With
        .addattachment (fic)
        .send
    End With
    Kill fic    'après l'envoi la feuille PDF est supprimée
        
        
     '   Sheets("ProtoAni1").Visible = False 'masque l'onglet
 
fin:       ' si erreur on sort de la procédure : description de l'erreur survenue
If Err.Number <> 0 Then MsgBox "Anomalie détectée" & vbLf & vbLf & Err.Description

Sheets("Choix").Select

Unload Protocols  'ferme l'Userform de séléction des protocoles
Unload UserForm2  'ferme l'Userform MENU
Load Protoconfirm


End Sub

Private Sub UserForm_Activate()
    Dim sh As Worksheet
    For Each sh In Worksheets
        cbx.AddItem sh.Name
    Next
End Sub
 
Vote positif 0 Vote négatif
Dranreb

Dranreb

XLDnaute Barbatruc
Si vous n'avez plus qu'une ComboBox c'est
VB: 
ComboBox1.List = Range("DETARTRAGE:TREMPAGE").Value
Il serait aussi possible de faire tout ça avec deux ListBox, une pour les Disponibles et une pour les À envoyer
Mais vous m'avez l'air de revenir à vos 5 ComboBox. Dans ce cas appliquez simplement mon 2ième code du poste #48
 
Dernière édition:
Vote positif 0 Vote négatif
Dranreb

Dranreb

XLDnaute Barbatruc
Avec deux ListBox ça pourrait ressembler à ça :
VB: 
Option Explicit
Private TDon() As String, TLgn() As Long, TÀEnv() As Boolean
Private Sub UserForm_Initialize()
   LBxLaisser.List = WshRègles.[DETARTRAGE:TREMPAGE].Resize(, 2).Value
   End Sub
Private Sub LBxLaisser_Click()
   Dim LEnv As Long, LLss As Long
   LEnv = LBxEnvoyer.ListCount
   LLss = LBxLaisser.ListIndex
   LBxEnvoyer.AddItem LBxLaisser.List(LLss, 0)
   LBxEnvoyer.List(LEnv, 1) = LBxLaisser.List(LLss, 1)
   LBxLaisser.ListIndex = -1
   LBxLaisser.RemoveItem LLss
   End Sub
Private Sub LBxEnvoyer_Click()
   Dim LEnv As Long, LLss As Long
   LEnv = LBxEnvoyer.ListIndex
   LLss = LBxLaisser.ListCount
   LBxLaisser.AddItem LBxEnvoyer.List(LEnv, 0)
   LBxLaisser.List(LLss, 1) = LBxEnvoyer.List(LEnv, 1)
   LBxEnvoyer.ListIndex = -1
   LBxEnvoyer.RemoveItem LEnv
   End Sub
Private Sub CBnEnvoyer_Click()
   Dim TNomsFeui() As String, L As Long
   ReDim TNomsFeui(0 To LBxEnvoyer.ListCount - 1)
   For L = 0 To UBound(TNomsFeui): TNomsFeui(L) = LBxEnvoyer.List(L, 1): Next L
   Sheets(TNomsFeui).Select
' Et ici le reste du bazar commençant par
'   ActiveSheet.ExportAsFixedFormat …
   End Sub
Attention: les colonne E et F doivent être interverties dans la feuille "RèglesProto", dont l'objet Worksheet qui la représente doit être nommé WshRègles.
Et les ListBox doivent avoir leurs propriété ListCount = 2. Width = 144 et ColumnWidths = "120 pt; 18 pt"
 
Dernière édition:
Vote positif 0 Vote négatif
jeromeN95

jeromeN95

XLDnaute Impliqué
Je vous remercie pour tout le temps passé,
Et je ne comprends pas exactement la dernière partie :

« Attention: les colonne E et F doivent être interverties dans la feuille "RèglesProto", dont l'objet Worksheet qui la représente doit être nommé WshRègles. »

Je dois mettre WshRègles as string ?


« Et les ListBox doivent avoir leurs propriété ListCount = 2. Width = 144 et ColumnWidths = "120 pt; 18 pt" »
??
 
Vote positif 0 Vote négatif
Dranreb

Dranreb

XLDnaute Barbatruc
Vous voyez bien: j'affecte directement la valeur de la plage à deux colonnes à la propriété List de la ListBox LBxLaisser, alors j'aimerais bien que les noms de feuilles soient dans la colonne qui suit les désignations, la E donc et non la F comme actuellement.
Les objets Worksheet de la rubrique Microsoft Excel Objets n'ont pas besoin d'être déclarés, il sont connus dans tout le projet VBA. Pour changer le nom d'un objet VBA c'est toujours sa propriété (Name) dans la fenêtre de propriété.
Cherchez ces propriétés dans la fenêtre de propriétés: elles y sont pour une ListBox.
1580833957689.png
 
Dernière édition:
Vote positif 0 Vote négatif
jeromeN95

jeromeN95

XLDnaute Impliqué
ok donc l'ensemble du code :

VB: 
Option Explicit

Dim texte
Private Sub cbx_Change()
    If cbx.ListIndex > -1 Then
        If Not texte Like "*" & cbx.Value & "*" Then texte = texte & cbx.Value & "|"
        cbx.ListIndex = -1
    End If
    TextBox1 = Replace(texte, "|", vbCrLf)
End Sub

Private Sub cbx_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If Button = 2 Then texte = "": cbx.ListIndex = -1: Exit Sub
End Sub

Option Explicit
Private TDon() As String, TLgn() As Long, TÀEnv() As Boolean
Private Sub UserForm_Initialize()
   LBxLaisser.List = WshRègles.[DETARTRAGE:TREMPAGE].Resize(, 2).Value
   End Sub
Private Sub LBxLaisser_Click()
   Dim LEnv As Long, LLss As Long
   LEnv = LBxEnvoyer.ListCount
   LLss = LBxLaisser.ListIndex
   LBxEnvoyer.AddItem LBxLaisser.List(LLss, 0)
   LBxEnvoyer.List(LEnv, 1) = LBxLaisser.List(LLss, 1)
   LBxLaisser.ListIndex = -1
   LBxLaisser.RemoveItem LLss
   End Sub
Private Sub LBxEnvoyer_Click()
   Dim LEnv As Long, LLss As Long
   LEnv = LBxEnvoyer.ListIndex
   LLss = LBxLaisser.ListCount
   LBxLaisser.AddItem LBxEnvoyer.List(LEnv, 0)
   LBxLaisser.List(LLss, 1) = LBxEnvoyer.List(LEnv, 1)
   LBxEnvoyer.ListIndex = -1
   LBxEnvoyer.RemoveItem LEnv
   End Sub
Private Sub CBnEnvoyer_Click()
   Dim TNomsFeui() As String, L As Long
   ReDim TNomsFeui(0 To LBxEnvoyer.ListCount - 1)
   For L = 0 To UBound(TNomsFeui): TNomsFeui(L) = LBxEnvoyer.List(L, 1): Next L
   Sheets(TNomsFeui).Select
' Et ici le reste du bazar commençant par
'   ActiveSheet.ExportAsFixedFormat …

    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                                    Chemin, Quality:=xlQualityStandard, _
                                    IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
                                    False
                                    
                                    
                                    
                    ' ENVOYER PAR MAIL
     fic = ThisWorkbook.Path & "\Protocols.pdf"      'nom du fichier crée précédement

    Set omg = CreateObject("CDO.Message")
    With omg
        .Subject = "Protocole d'utilisation des produits"        'sujet
        .From = "jer@fournisseur.fr"      ' adresse mail de l'expéditeur
        .To = "jerome-prevost@hotmail.fr"   '[A25].Value              ' Email du destinataire
       ' .CC = [A5].Value                 'vendeur en copie
        .TextBody = "Bonjour, veuillez trouver ci-joint le(s) protocole(s) d'utilisation de nos produits. Bien à vous, La Sociétée"
        With .Configuration.Fields
            .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.orange.fr"
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
            .Update
        End With
        .addattachment (fic)
        .send
    End With
    Kill fic    'après l'envoi la feuille PDF est supprimée
        
        
     '   Sheets("ProtoAni1").Visible = False 'masque l'onglet
 
fin:       ' si erreur on sort de la procédure : description de l'erreur survenue
If Err.Number <> 0 Then MsgBox "Anomalie détectée" & vbLf & vbLf & Err.Description

Sheets("Choix").Select

Unload Protocols  'ferme l'Userform de séléction des protocoles
Unload UserForm2  'ferme l'Userform MENU
Load Protoconfirm


End Sub

Private Sub UserForm_Activate()
    Dim sh As Worksheet
    For Each sh In Worksheets
        cbx.AddItem sh.Name
    Next
End Sub

Donc plus du Combobox mais une listebox. OK, je test ca de suite
 
Vote positif 0 Vote négatif

Discussions similaires

J
  • Résolu(e)
XL 2021 Envoi d'email et PJ en VBA
Réponses
3
Affichages
530
JPaul78
J
gothc
  • Question
XL 2019 erreur .send
Réponses
1
Affichages
501
Oneida
Oneida
C
  • Question
XL 2010 Probleme pour envoi d'un mail depuis excel avec gmail
Réponses
6
Affichages
2 K
chris66000
C
jeromeN95
  • Question
XL 2013 envoie mail pdf chemin bureau Windows ??
Réponses
4
Affichages
1 K
fanch55
fanch55
G
  • Question
Microsoft 365 envoie feuille active avec excel par email
Réponses
0
Affichages
1 K
glfred
G
P
  • Question
XL 2019 Macro qui ralenti mon classeur après exécution
Réponses
2
Affichages
727
pat66
P
L
  • Question
XL 2019 CDO.message et corps de mail
Réponses
2
Affichages
2 K
Hasco
Hasco
A
  • Question
Microsoft 365 Génération d'une feuille en Pdf et envoie par outlook
Réponses
5
Affichages
1 K
patricktoulon
patricktoulon
sergiofox
  • Question
Microsoft 365 Macro PDF et envoie mail Windows - bug sur Mac
Réponses
6
Affichages
1 K
sergiofox
sergiofox
jeromeN95
  • Question
XL 2010 Envoyer par mail en fonction d'un UserForm arpés selection
Réponses
3
Affichages
699
jeromeN95
jeromeN95

Membres actuellement en ligne

2 membres et 85 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 729
Messages
2 112 271
Membres
111 482
dernier inscrit
constykam