Microsoft 365 envoie par mail en fonction Combobox

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: 6

Dranreb

XLDnaute Barbatruc
Pour préparer le tableau dans l'UserForm vous pouvez faire comme ça :
VB:
Private Sub CommandButton1_Click()
   Dim TPièces() As String, C As Long, N As Long, CBx As MSForms.ComboBox
   ReDim TPièces(1 To 5)
   For C = 1 To 5
      Set CBx = Me("ComboBox" & C)
      If CBx.MatchFound Then N = N + 1: TPièces(N) = CBx.Text
      Next C
   If N > 0 Then
      ReDim Preserve TPièces(1 To N)
      EnvProto TPièces
      End If
   End Sub
Après dans la Sub EnvProto vous pouvez faire For N = 1 To UBound(TPièces)
mais après je ne sais pas ce qu'il faut faire du TPièces(N) car votre code ne semble fait que pour une seule pièce.
 

Dranreb

XLDnaute Barbatruc
Vous avez des procédures qui manquent, et vous ne transmettez pas votre tableau en argument à la procédure.
N'utilisez pas le '_' dans les noms de procédures ordinaires. Il sert de séparateur dans les noms de procédures de prises en charge d'évènements entre le nom de l'objet et le nom de l'évènement.
Et mettez une majuscule au début et aussi, si c'est un nom composé dont tous le mots sont donc collés, au début de chaque mot.
 
Dernière édition:

Dranreb

XLDnaute Barbatruc
Si les numéros portés en colonne F de la feuille RèglesProto doivent, converties en textes, donner lieu aux nomx des feuilles à retenir, vous pouvez faire comme ça :
UserForm Protocole :
VB:
Private Sub CommandButton1_Click()
Dim Wsh As Worksheet, TWsh() As Worksheet, NomFeui As String, C As Long, N As Long, CBx As MSForms.ComboBox
ReDim TWsh(1 To 5)
For C = 1 To 5
   Set CBx = Me("ComboBox" & C)
   If CBx.MatchFound Then
      NomFeui = Trim$(6 * C + CBx.ListIndex - 5)
      On Error Resume Next: Set Wsh = ThisWorkbook.Worksheets(NomFeui)
      If Err Then
         MsgBox "Feuille """ & NomFeui & """ inexistante pour """ & CBx.Text & """.", vbExclamation
      Else: N = N + 1: Set TWsh(N) = Wsh: End If
      End If
   Next C
   If N > 0 Then
      ReDim Preserve TWsh(1 To N)
      EnvoiProto TWsh
      End If
   End Sub
Module Env_Protocole_Mail, le début de la procédure, pour vérif :
VB:
Public Sub EnvoiProto(TWsh() As Worksheet) 'Envoie le ou les protocoles par mail
Dim TNomsFeui() As String, N As Long
ReDim TNomsFeui(1 To UBound(TWsh))
For N = 1 To UBound(TWsh)
   TNomsFeui(N) = """" & TWsh(N).Name & """"
   Next N
MsgBox "Les feuilles suivantes ont été retenues :  " & Join(TNomsFeui, ", ") & ".", vbInformation
Mettez provisoirement tout le reste en commentaire jusqu'à ce que vous aurez décidé de ce qu'il faut faire, vu que maintenant il y a plusieurs feuilles à considérer, alors que votre code ne semblait fait que pour une seule.
 

jeromeN95

XLDnaute Impliqué
Bonsoir,
merci d'avoir pris du temps pour m'aider.

Quels qualificateur peut prendre TNomsFeuil ?

Afin d'ajouter les feuilles retenus en PDF SVP ?

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
Dim C As Long

Dim TNomsFeui() As String, N As Long

    On Error GoTo fin

   TNomsFeui(N).Value
   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("ComboBox" & C).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("ComboBox" & C).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

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

End Sub
 

Dranreb

XLDnaute Barbatruc
Vous n'avez encore toujours rien compris je vois.
Déjà dites moi une bonne fois pour toutes si votre Sub env_Propo doit traiter une seule feuille ou plusieurs, car je n'y ai toujours rien compris. Parcer que dans l'UserForm, alors qu'il y a 5 ComboBox, vous ne l"appelez qu'une fois, et dans la procédure il n'y a pas de boucle. Alors je ne comprend rien à ce que vous voulez faire.
(Vous tenez à tout prix à l'appeler env_Proto et pas EnvoiProto ?? pourquoi ?)
 

Statistiques des forums

Discussions
284 908
Messages
1 864 050
Membres
155 744
dernier inscrit
ddski69
Haut Bas