Discussion :

[graphikris]

Bonjour,
Je possède 2 PC (1 fixe et 1 portable). Tous les deux sont sous Windows 10 avec Office 2010. Mes deux PC sont configurés de la même manière.

Quand je déclenche ma macro avec mon fixe tout se passe bien alors que lorsque je la déclenche avec mon portable, j’ai ce msg d’erreur : « Erreur d’exécution ‘48’ – Erreur de chargement de la DLL »

J’ai cherché sur le net mais je n’ai pas vraiment de solution à ce problème.

Quelle est donc cette DLL afin que je puisse la coller dans mon portable.

Ma macro est sensée ouvrir OUTLOOK afin d’envoyer par mail une feuille Excel enregistrée au format Pdf.

Voici la ligne de commande où ça me met ce msg d’erreur :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
'Contrôler dans Visual Basic/Outils/Références/que Microsoft Outlook --,- Object Librairy est bien coché
        Dim olapp As Outlook.Application

Je tiens à préciser qu’au niveau des references dans VBA, tout est identique sur les 2 PC (outlook n’est pas manquant)

Cordialement

[joe.levrai]

Bonjour,

il est possible que tu ai développé ton projet sous une référence Microsot Outlook XX.X Object Library et que ton second environnement possède la référence YY.Y

pour éviter ces problèmes de références, quand un projet est porté sur plusieurs machines, on peut travailler en liaison tardive afin de ne pas utiliser une librairie définie, mais la librairie disponible sur la machine utilisée

la conversion n'est pas très compliquée, on utilise plus les objets "nommés" de Outlook, on passe par des variables Object et seulement à l'exécution on dis à VBA ce qu'est l'objet

ainsi un :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Dim olapp As Outlook.Application
Set olapp = New Outlook.Application

devient :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Dim olapp As Object
Set olapp = CreateObject("Outlook.Application")
 
'ici on créer un mail qu'on va envoyer
With OlApp.CreateItem(0)
    .Subject = Sujet
    .Body = Corps
    .To = Destinataire
    .Send
End With

Il y a donc deux choses à veiller :

- on va devoir soi-même désigner ce qu'est l'objet en le créant
- nous n'avons plus accès aux constantes du modèle objet Outlook, raison pour laquelle j'ai mis en exemple la création d'un Item mail ... qui en liaison précoce accepte .CreateItem(olMailItem) mais qui en liaison tardive oblige à utiliser la constante numérique plutôt que la constante nommée (.CreateItem(0))


Quand on a pas trop l'habitude des objets d'une librairie, on développer son projet en liaison précoce, on a ainsi accès aux constantes et à la saisie intuitive ... et quand le projet est bouclé on converti ça en liaison tardive (remplacement des constantes et gestion des objets à créer)


Voici pour plus de détails : http://mhubiche.developpez.com/vba/f...endre/binding/

[graphikris]

Bonjour Joe et merci pour tes explications
Donc pour résumé, voici le nouveau code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
        'Envoi du mail
        'Contrôler dans Visual Basic/Outils/Références/que Microsoft Outlook --,- Object Librairy est bien coché
        'Dim olapp As Outlook.Application
        Dim olapp As Object
Set olapp = CreateObject("Outlook.Application")
 
       'Contrôle la validité ou la présence d'adresse mail en B7
        Dim msg As MailItem
        Set olapp = New Outlook.Application
        Set msg = olapp.CreateItem(olMailItem)
        'Adresse de la cellule contenant la liste des adresses mails
        msg.To = Range("B7").Value
        'Envoi en copie
         msg.CC = " "
        'Envoi en copie cachée
        msg.BCC = " "
        'Saisir le sujet de l'envoi
        msg.Subject = "Fiche du processus " & Feuil9.Range("A2")
        'Saisie du message
        'Saisir Corps du message
        msg.Body = "Le xxx vous transmet la fiche de votre processus." & Chr(13) & Chr(13) & "En cas de désaccord avec les informations transmises, veuillez transmettre les correctifs au plus vite par mail uniquement à l'adresse suivante : xxxxx@gmail.com" & Chr(13) & Chr(13) & "En cas de non réponse de votre part sous 5 jours calendaires, la fiche sera considérée comme correcte." & Chr(13) & Chr(13) & Chr(13) & "Ci-joint la fiche concernant votre processus." & Chr(13) & Chr(13) & Chr(13) & "Respectueusement," & Chr(13) & "L'équipe xxx."
        'Adresse de la pièce jointe
        msg.Attachments.Add Source:=sNomPdf
 
        msg.Display
        'Transmission du message
        msg.Send

Sinon comment dois je disposer ton code en remplacement du mien à partir de la ligne 8 ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
With olapp.CreateItem(0)
    .Subject = Sujet
    .Body = Corps
    .To = Destinataire
    .Send
End With

[joe.levrai]

Tu as mélangé liaison précoce et tardive

ligne 4 et 5 tu crées ton objet Outlook.application via une nouvelle instance du client
et ligne 9 tu repasses sur ta variable, en créant une nouvelle instance Outlook via une liaison précoce


Quand on fait du Outlook dans Excel, c'est vraiment conseillé de décomposer les tâches récurrentes en sous-procédure

voici une sous-procédure qui effectue le travail de créer un mail et de l'envoyer.
il faut simplement que l'objet OlApp ai été crée par la procédure appelante ... là encore je passe personnellement par une sous-procédure

Créer l'instance si elle n'existe pas (sinon on la récupère par un GetObject)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Dim olapp As Object
Sub InitialisationOutlook()
    On Error Resume Next: Set olapp = GetObject(, "Outlook.Application"): On Error GoTo 0
    If olapp Is Nothing Then Set olapp = CreateObject("Outlook.Application")
End Sub

Envoyer un mail, avec Sujet/Corps/Destinataire/Eventuelle pièce jointe (on peut ajouter des paramètres pour la mise en copie ou copie cachée si on veut ... et d'autres paramètres encore)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Sub EnvoiMail(ByVal Sujet As String, ByVal Corps As String, ByVal Destinataire As String, Optional Pj As String = "")
    With olapp.CreateItem(0)
        .Subject = Sujet
        .Body = Corps
        .To = Destinataire
        If Pj <> "" Then .Attachments.Add Pj
        .Send
    End With
End Sub

Et voici notre procédure appelante, elle est chargée de transmettre les ordres et les informations aux sous-procédures
J'ai utilisé des variables optionnelles pour que l'appel de la fonction EnvoiMail soit simple pour toi à comprendre ... on peut parfaitement s'en passer

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Sub Test()
Dim UnSujet As String, UnDestinataire As String, UnCorps As String, UnePj As String
 
InitialisationOutlook
    UnSujet = "Fiche du processus " & Feuil9.Range("A2").Value
    UnDestinataire = Range("B7").Value
    UnCorps = "Le xxx vous transmet la fiche de votre processus." & Chr(13) & Chr(13) & "En cas de désaccord avec les informations transmises, veuillez transmettre les correctifs au plus vite par mail uniquement à l'adresse suivante : xxxxx@gmail.com" & Chr(13) & Chr(13) & "En cas de non réponse de votre part sous 5 jours calendaires, la fiche sera considérée comme correcte." & Chr(13) & Chr(13) & Chr(13) & "Ci-joint la fiche concernant votre processus." & Chr(13) & Chr(13) & Chr(13) & "Respectueusement," & Chr(13) & "L'équipe xxx."
    UnePj = sNomPdf
Call EnvoiMail(UnSujet, UnCorps, UnDestinataire, UnePj)
End Sub

Maintenant, t'as deux briques fondamentales qui tu peux utiliser partout dans ton projet, copier dans d'autres projets etc...
tu n'as plus à te soucier de créer ou récupérer Outlook, ou envoyer un mail !


Partant de là, c'est la porte ouverte à beaucoup de possibilités pour organiser des projets complexes

Tiens, des exemples :
Partant d'un Objet "dossier Outlook", ici on fait la sommes de toutes les éléments du dossier et de ses sous dossiers

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Function SommeArbo(Undossier As Object, Optional ListeExclusion As Variant) As Long
' ListeExclusion est un Array composé de noms de dossiers qu'on ne voudrait pas inclure dans la somme
Dim LeDossier As Object
SommeArbo = Undossier.Items.Count
    For Each LeDossier In Undossier.Folders
        If Not IsMissing(ListeExclusion) Then
            If Not IsInArray(LeDossier.Name, ListeExclusion) Then SommeArbo = SommeArbo + LeDossier.Items.Count
        Else
            SommeArbo = SommeArbo + LeDossier.Items.Count
        End If
    Next LeDossier
End Function

Ici, on calcule le mail le plus ancien dans l'arborescence

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Function PlusAncienArbo(Undossier As Object, Optional ListeExclusion As Variant) As Long
Dim LeDossier As Object
 
On Error Resume Next
    PlusAncienArbo = CLng(Date)
    If Undossier.Items.Count > 0 Then PlusAncienArbo = Application.Min(PlusAncienArbo, CLng(CDate(Left(Undossier.Items(Undossier.Items.Count).ReceivedTime, 10))))
        For Each LeDossier In Undossier.Folders
            If LeDossier.Items.Count > 0 Then
                If Not IsMissing(ListeExclusion) Then
                    If Not IsInArray(LeDossier.Name, ListeExclusion) Then PlusAncienArbo = Application.Min(PlusAncienArbo, CLng(CDate(Left(LeDossier.Items(LeDossier.Items.Count).ReceivedTime, 10))))
                Else
                    PlusAncienArbo = Application.Min(PlusAncienArbo, CLng(CDate(Left(LeDossier.Items(LeDossier.Items.Count).ReceivedTime, 10))))
                End If
            End If
        Next LeDossier
On Error GoTo 0
 
If PlusAncienArbo = 0 Then PlusAncienArbo = CLng(Date)
End Function

Il y a une fonction utilisée dans ces deux fonctions : IsInArray (pour vérifier si un élément existe dans un array)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Public Function IsInArray(ValeurCherchée As Variant, ArrayDeRecherche As Variant) As Boolean
' récupéré par auteur Inconnu || adaptée et commentée
' fonction qui vérifie si une chaine de caractère est dans un Array
' retourne Vrai si c'est dedans, sinon retourne Faux
    If Not IsArray(ArrayDeRecherche) Then Exit Function
    IsInArray = InStr(1, vbNullChar & Join(ArrayDeRecherche, vbNullChar) & vbNullChar, vbNullChar & ValeurCherchée & vbNullChar) > 0
End Function

Là, on fait la même chose, mais on ne travaille que dans le dossier, sans s'occuper de ses sous-dossiers

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Function PlusAncienNonArbo(DossierRecherche As Object) As Long
On Error Resume Next
    With DossierRecherche
        If .Items(.Items.Count).class = 43 Then
            PlusAncienNonArbo = CLng(CDate(Left(.Items(.Items.Count).ReceivedTime, 10)))
        Else
            PlusAncienNonArbo = CLng(CDate(Left(.Items(.Items.Count).CreationTime, 10)))
        End If
    End With
On Error GoTo 0
 
If PlusAncienNonArbo = 0 Then PlusAncienNonArbo = CLng(Date)
 
End Function

La porte ouverte à tout, j'ai dis

[graphikris]

Merci à toi Joe, pour tes reponses rapides et faciles a comprendre.
Je teste tout çà sur mon portable et te tiens au courant fin d'aprem.

[graphikris]

Joe,

Je constate que tu as donc créé 3 modules mais pour ma macro comment dois je procéder car celle-ci se déroule de la maniere suivante :
Avant d'envoyer le mail, elle va renseigner une feuille à partir de plusieurs feuilles, cette feuille renseignée se nomme "Synthese", ensuite la macro enregistre cette feuille au format Pdf pour ensuite la transmettre par mail mais ma macro ne se termine pas là, car ensuite, elle va imprimer cette feuille "synthese" puis enfin vider la feuille "synthese" des renseignements qui y ont ete mis par le biais de ma macro.
voici mon code, je n'ai pas mis le debut car trop long

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
    If Mail = "Oui" Then
        'Création du Pdf
        Dim sNomPdf As String
        Dim sDossier As String
        Dim Destinataire As String
 
        sDossier = ThisWorkbook.Path
 
        sNomPdf = sDossier & "\" & "Synthese du processus " & Feuil9.Range("A2") & " _ Extraction du " & _
                  Replace(Replace(Replace(Left(Now, 16), ":", "h"), " ", " à "), "/", "-") & ".pdf"
 
        Feuil9.ExportAsFixedFormat _
                Type:=xlTypePDF, _
                Filename:=sNomPdf, _
                Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, _
                IgnorePrintAreas:=False, _
                OpenAfterPublish:=False
 
*
        'Envoi du mail
        On Error Resume Next: Set olapp = GetObject(, "Outlook.Application"): On Error GoTo 0
    If olapp Is Nothing Then Set olapp = CreateObject("Outlook.Application")
 
 
      End If
 
    'Procédure de demande d impression
    If Imprim = "OUI" Then
 
        ActiveWindow.SelectedSheets.PrintOut Copies:=NbreCopie
        End If
 
 
    ' Reprise de la macro jusqu'à la fin des processus sélectionnés
 
 
 
    'Affichage feuille
    Application.ScreenUpdating = True
 
    'Protection de la feuille
    ActiveSheet.Protect
    Range("A9").Select

/est il possible de mettre les codes de tes 3 modules dans ma macro à partir de la ligne 22 ou pas ?

[joe.levrai]

Tu peux bien sûr rassembler toutes les sous-procédures dans une unique procédure, mais tu perd en agilité, c'est dommage

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
If Mail = "Oui" Then
sDossier = ThisWorkbook.Path
 
        sNomPdf = sDossier & "\" & "Synthese du processus " & Feuil9.Range("A2") & " _ Extraction du " & _
                  Replace(Replace(Replace(Left(Now, 16), ":", "h"), " ", " à "), "/", "-") & ".pdf"
 
        Feuil9.ExportAsFixedFormat _
                Type:=xlTypePDF, _
                Filename:=sNomPdf, _
                Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, _
                IgnorePrintAreas:=False, _
                OpenAfterPublish:=False
    InitialisationOutlook
    UnSujet = "Fiche du processus " & Feuil9.Range("A2").Value
    UnDestinataire = Range("B7").Value
    UnCorps = "Le xxx vous transmet la fiche de votre processus." & Chr(13) & Chr(13) & "En cas de désaccord avec les informations transmises, veuillez transmettre les correctifs au plus vite par mail uniquement à l'adresse suivante : xxxxx@gmail.com" & Chr(13) & Chr(13) & "En cas de non réponse de votre part sous 5 jours calendaires, la fiche sera considérée comme correcte." & Chr(13) & Chr(13) & Chr(13) & "Ci-joint la fiche concernant votre processus." & Chr(13) & Chr(13) & Chr(13) & "Respectueusement," & Chr(13) & "L'équipe xxx."
    UnePj = sNomPdf
Call EnvoiMail(UnSujet, UnCorps, UnDestinataire, UnePj)
End If

c'est quand même plus pratique

n'oublie pas : ta procédure principale peut "faire des choses" et "donner des ordres à d'autres procédures dédiées à la réalisation de tâches définies".

[graphikris]

Ok je comprends. Et si je procede comme ça, ca bug à la ligne 68 par rapport à la ligne 29 :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
Option Explicit
Dim olapp As Object
Sub InitialisationOutlook()
    On Error Resume Next: Set olapp = GetObject(, "Outlook.Application"): On Error GoTo 0
    If olapp Is Nothing Then Set olapp = CreateObject("Outlook.Application")
End Sub
Sub EnvoiMail(ByVal Sujet As String, ByVal Corps As String, ByVal Destinataire As String, Optional Pj As String = "")
    With olapp.CreateItem(0)
        .Subject = Sujet
        .Body = Corps
        .To = Destinataire
        If Pj <> "" Then .Attachments.Add Pj
        .Send
    End With
End Sub
 
 
Sub Transmission_Mail()
Dim UnSujet As String, UnDestinataire As String, UnCorps As String, UnePj As String
*
InitialisationOutlook
    UnSujet = "Fiche du processus " & Feuil9.Range("A2").Value
    UnDestinataire = Range("B7").Value
    UnCorps = "Le xxx vous transmet la fiche de votre processus." & Chr(13) & Chr(13) & "En cas de désaccord avec les informations transmises, veuillez transmettre les correctifs au plus vite par mail uniquement à l'adresse suivante : xxxxx@gmail.com" & Chr(13) & Chr(13) & "En cas de non réponse de votre part sous 5 jours calendaires, la fiche sera considérée comme correcte." & Chr(13) & Chr(13) & Chr(13) & "Ci-joint la fiche concernant votre processus." & Chr(13) & Chr(13) & Chr(13) & "Respectueusement," & Chr(13) & "L'équipe xxx."
    UnePj = sNomPdf
Call EnvoiMail(UnSujet, UnCorps, UnDestinataire, UnePj)
End Sub
 
Private Sub CommandButton2_Click()    ' lancer automatisation du processus
Dim i As Integer
    Dim j As Integer
    Dim Trouve As Range
    Dim PlageDeRecherche As Range
    Dim Valeur_Cherchee As String
    Dim AdresseTrouvee As String
    Dim Lig As Integer
    Dim Col As Integer
    Dim Processus As String
    Dim Imprim As String
    Dim Mail As String
    Dim AdrMail As String
    AdrMail = ""
 
'ici le reste du code pour déclencher la synthese
 
 ' avant l'envoi mail dire - if Mail ="OUI" then...- lancer macro de l'envoi mail
 
    If Mail = "Oui" Then
        'Création du Pdf
        Dim sNomPdf As String
        Dim sDossier As String
        Dim Destinataire As String
 
        sDossier = ThisWorkbook.Path
 
        sNomPdf = sDossier & "\" & "Synthese du processus " & Feuil9.Range("A2") & " _ Extraction du " & _
                  Replace(Replace(Replace(Left(Now, 16), ":", "h"), " ", " à "), "/", "-") & ".pdf"
 
        Feuil9.ExportAsFixedFormat _
                Type:=xlTypePDF, _
                Filename:=sNomPdf, _
                Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, _
                IgnorePrintAreas:=False, _
                OpenAfterPublish:=False
 
        'Envoi du mail
        Call Transmission_Mail
 
 
    End If
 
    'Procédure de demande d impression
    If Imprim = "OUI" Then
 
        ActiveWindow.SelectedSheets.PrintOut Copies:=NbreCopie
 
 
    End If
 
    'Affichage feuille
    Application.ScreenUpdating = True
 
    'Protection de la feuille
    ActiveSheet.Protect
    Range("A9").Select
End Sub

[joe.levrai]

Quel est le message d'erreur ?

tu peux enlever le Call de la ligne 68, perso je ne l'utilise que pour une procédure qui contient des paramètres (chose non obligatoire, on peut se passer des Call) et ta procédure transmission_mail n'en contient pas

attention également à la portée de tes variables

sNomPdf a une portée "procédure", elle ne dépasse pas l'étendu de la procédure où elle est déclarée. Or tu l'utilises dans ta sous-procédure transmission_mail

donc au choix :

- tu augmentes sa portée (en la déclarant en haut du module comme olapp)
- tu crées un paramètres dans ta procédure transmission_mail(CheminPdf As String) et tu modifies sont appel : Call transmission_pdf(sNomPdf)

[graphikris]

Bjr Joe,

Le msg d'erreur est : Sub ou Function non definie
J'ai rajouté en ligne du 3eme code : CheminPdf As String
et en ligne 45 du dernier code j'ai mis ça : Call transmission_pdf(sNomPdf)

ça ne fonctionne tjrs pas

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Option Explicit
Dim olapp As Object
Sub InitialisationOutlook()
    On Error Resume Next: Set olapp = GetObject(, "Outlook.Application"): On Error GoTo 0
    If olapp Is Nothing Then Set olapp = CreateObject("Outlook.Application")
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Sub EnvoiMail(ByVal Sujet As String, ByVal Corps As String, ByVal Destinataire As String, Optional Pj As String = "")
    With olapp.CreateItem(0)
        .Subject = Sujet
        .Body = Corps
        .To = Destinataire
        If Pj <> "" Then .Attachments.Add Pj
        .Send
    End With
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Sub Transmission_Mail()
Dim UnSujet As String, UnDestinataire As String, UnCorps As String, UnePj As String, CheminPdf As String
*
InitialisationOutlook
    UnSujet = "Fiche du processus " & Feuil9.Range("A2").Value
    UnDestinataire = Range("B7").Value
    UnCorps = "Le xxx vous transmet la fiche de votre processus." & Chr(13) & Chr(13) & "En cas de désaccord avec les informations transmises, veuillez transmettre les correctifs au plus vite par mail uniquement à l'adresse suivante : xxxxx@gmail.com" & Chr(13) & Chr(13) & "En cas de non réponse de votre part sous 5 jours calendaires, la fiche sera considérée comme correcte." & Chr(13) & Chr(13) & Chr(13) & "Ci-joint la fiche concernant votre processus." & Chr(13) & Chr(13) & Chr(13) & "Respectueusement," & Chr(13) & "L'équipe xxx."
    UnePj = sNomPdf
Call EnvoiMail(UnSujet, UnCorps, UnDestinataire, UnePj)
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
Private Sub CommandButton2_Click()    ' lancer automatisation du processus

    Dim i As Integer
    Dim j As Integer
    Dim Trouve As Range
    Dim PlageDeRecherche As Range
    Dim Valeur_Cherchee As String
    Dim AdresseTrouvee As String
    Dim Lig As Integer
    Dim Col As Integer
    Dim Processus As String
    Dim Imprim As String
    Dim Mail As String
    Dim AdrMail As String
    AdrMail = ""


' ICI LE RESTE DU CODE POUR EXTRAIRE LA SYNTHESE PAR RAPPORT A D AUTRES FEUILLES DU CLASSEUR



' avant l'envoi mail dire - if Mail ="OUI" then...- lancer macro de l'envoi mail

    If Mail = "Oui" Then
        'Création du Pdf
        Dim sNomPdf As String
        Dim sDossier As String
        Dim Destinataire As String

        sDossier = ThisWorkbook.Path

        sNomPdf = sDossier & "\" & "Synthese du processus " & Feuil9.Range("A2") & " _ Extraction du " & _
                  Replace(Replace(Replace(Left(Now, 16), ":", "h"), " ", " à "), "/", "-") & ".pdf"

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

*
        'Envoi du mail
        Call transmission_pdf(sNomPdf)
 
    End If

    'Procédure de demande d impression
    If Imprim = "OUI" Then

        ActiveWindow.SelectedSheets.PrintOut Copies:=1
        
      
    End If

    ' Reprise de la macro jusqu'à la fin des processus sélectionnés

    'Affichage feuille
    Application.ScreenUpdating = True

    'Protection de la feuille
    ActiveSheet.Protect
    Range("A9").Select

End Sub

[graphikris]

Toujours ce message d'erreur :

Sub ou Function non definie

Quelqu'un pour m'aider ?

[joe.levrai]

Bah le message est assez clair, sur la ligne qui plante, tu appelles une procédure qui n'existe pas

effectivement transmission_pdf n'existe pas, c'est transmission_mail qui existe

et tu lui envoie un paramètre (sNomPdf) alors que tu n'as pas modifié la déclaration de ta procédure comme je l'avais montré... c'est la prochaine erreur qui te guette quand tu auras corrigé la première, je prend les devants

[graphikris]

Salut,

Tout fonctionne hormis la PJ qui n'est pas attachée au mail. Le PDF se crée bien, mais a la reception du mail, la PJ n'y se trouve pas.
Je te remet les codes que j'ai modifié :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Option Explicit
Dim Ws         As Worksheet
Dim olapp      As Object

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Sub InitialisationOutlook()
    On Error Resume Next: Set olapp = GetObject(, "Outlook.Application"): On Error GoTo 0
    If olapp Is Nothing Then Set olapp = CreateObject("Outlook.Application")
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Sub EnvoiMail(ByVal Sujet As String, ByVal Corps As String, ByVal Destinataire As String, Optional Pj As String = "")
 
    With olapp.CreateItem(0)
        .Subject = Sujet
        .Body = Corps
        .To = Destinataire
        If Pj <> "" Then .Attachments.Add Pj
        .Send
    End With
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Sub Transmission_Mail()
Dim UnSujet As String, UnDestinataire As String, UnCorps As String, UnePj As String, sNomPdf As String
    InitialisationOutlook
    UnSujet = "Fiche du processus " & Feuil9.Range("A2").Value
    UnDestinataire = Range("B7").Value
    UnCorps = "Le xxx vous transmet la fiche de votre processus." & Chr(13) & Chr(13) & "En cas de désaccord avec les informations transmises, veuillez transmettre les correctifs au plus vite par mail uniquement à l'adresse suivante : xxxxx@gmail.com" & Chr(13) & Chr(13) & "En cas de non réponse de votre part sous 5 jours calendaires, la fiche sera considérée comme correcte." & Chr(13) & Chr(13) & Chr(13) & "Ci-joint la fiche concernant votre processus." & Chr(13) & Chr(13) & Chr(13) & "Respectueusement," & Chr(13) & "L'équipe xxx."
    UnePj = sNomPdf
    Call EnvoiMail(UnSujet, UnCorps, UnDestinataire, UnePj)
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Private Sub CommandButton2_Click()    ' lancer automatisation du processus
Dim i      As Integer
    Dim j      As Integer
    Dim Trouve As Range
    Dim PlageDeRecherche As Range
    Dim Valeur_Cherchee As String
    Dim AdresseTrouvee As String
    Dim Lig    As Integer
    Dim Col    As Integer
    Dim Processus As String
    Dim Imprim As String
    Dim Mail   As String
    Dim AdrMail As String
    AdrMail = ""
 
 
'ICI LE RESTE DU CODE DE LA MACRO PUIS
 
' avant l'envoi mail dire - if Mail ="OUI" then...- lancer macro de l'envoi mail
 
    If Mail = "Oui" Then
        'Création du Pdf
        Dim sNomPdf As String
        Dim sDossier As String
        Dim Destinataire As String
 
        sDossier = ThisWorkbook.Path
 
        sNomPdf = sDossier & "\" & "Synthese du processus " & Feuil9.Range("A2") & " _ Extraction du " & _
                  Replace(Replace(Replace(Left(Now, 16), ":", "h"), " ", " à "), "/", "-") & ".pdf"
 
        Feuil9.ExportAsFixedFormat _
                Type:=xlTypePDF, _
                Filename:=sNomPdf, _
                Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, _
                IgnorePrintAreas:=False, _
                OpenAfterPublish:=False
 
 
        'Envoi du mail
        Call Transmission_Mail
 
 
    End If
End Sub

[joe.levrai]

Le plus simple pour éviter de créer un paramètre à ta procédure transmission_mail, c'est de déclarer

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Dim sNomPdf As String

en haut du module

car là, dans la procédure transmission_mail, il ne vaut qu'une chaine vide, puisque cette variable ne dépasse pas la portée de ta procédure principale.
quand tu l'utilises dans une autre procédure, c'est une toute autre variable (qui porte le même nom) est qui est vide

[unparia]

Bonjour
Je lis

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Dim UnSujet As String, UnDestinataire As String, UnCorps As String, UnePj As String, sNomPdf As String ' -->> qui fait que sNomPdf  ""
 ' ....... et rien qui ninitialise dans cette procédure sNomPdf
    UnePj = sNomPdf ' ---- et donc UnePj = ""
    Call EnvoiMail(UnSujet, UnCorps, UnDestinataire, UnePj) ' --->> on envoie ici "" comme 4ème paramètre ... -->> il n'y aura aucun miracle.

et on n'enverra aucune pièce jointe puisque

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Sub EnvoiMail(ByVal Sujet As String, ByVal Corps As String, ByVal Destinataire As String, Optional Pj As String = "")
 
    With olapp.CreateItem(0)
        .Subject = Sujet
        .Body = Corps
        .To = Destinataire
        If Pj <> "" Then .Attachments.Add Pj '--- Or, PJ = ""
        .Send
    End With
End Sub

[graphikris]

Merci a vous 2, vous etes tres sympa mais c'etait deja pas simple avec une reponse mais maintenant j'en ai deux et je ne comprends plus rien

Je place où ce : Dim sNomPdf As String et que devient le Optional Pj As String = ""

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Option Explicit
Dim Ws         As Worksheet
Dim olapp      As Object
Sub InitialisationOutlook()
    On Error Resume Next: Set olapp = GetObject(, "Outlook.Application"): On Error GoTo 0
    If olapp Is Nothing Then Set olapp = CreateObject("Outlook.Application")
End Sub
Sub EnvoiMail(ByVal Sujet As String, ByVal Corps As String, ByVal Destinataire As String, Optional Pj As String = "")
 
    With olapp.CreateItem(0)
        .Subject = Sujet
        .Body = Corps
        .To = Destinataire
        If Pj <> "" Then .Attachments.Add Pj
        .Send
    End With
End Sub
Sub Transmission_Mail()
Dim UnSujet As String, UnDestinataire As String, UnCorps As String, UnePj As String
    InitialisationOutlook
    UnSujet = "Fiche du processus " & Feuil9.Range("A2").Value
    UnDestinataire = Range("B7").Value
    UnCorps = "Le xxx vous transmet la fiche de votre processus." & Chr(13) & Chr(13) & "En cas de désaccord avec les informations transmises, veuillez transmettre les correctifs au plus vite par mail uniquement à l'adresse suivante : xxxxx@gmail.com" & Chr(13) & Chr(13) & "En cas de non réponse de votre part sous 5 jours calendaires, la fiche sera considérée comme correcte." & Chr(13) & Chr(13) & Chr(13) & "Ci-joint la fiche concernant votre processus." & Chr(13) & Chr(13) & Chr(13) & "Respectueusement," & Chr(13) & "L'équipe xxx."
    UnePj = sNomPdf
    Call EnvoiMail(UnSujet, UnCorps, UnDestinataire, UnePj)
End Sub

[joe.levrai]

C'est toi qui a compliqué l'affaire en créant une sous-procédure passerelle transmission_mail


coupe la ligne où tu déclares ta variable sNomPdf
et colle cette ligne en haut du module, juste en dessous de

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Dim olapp      As Object

après, si tu veux savoir pourquoi il faut faire ça, essaye de dérouler ton code en pas à pas avant de faire la modification, et regarde bien ce que veux sNomPdf quand tu arrives dans la procédure transmission_mail

refais l'opération APRES avoir modifié la déclaration de ta variable, et tu verras que sNomPdf conservera le chemin que tu y as placé dans la procédure principale.


EDIT : nous n'avons fait que de dire la même chose, avec nos propres mots et nos propres manières de les illustrer

[graphikris]

C'est ce que j'avais compris mais quand je l'ai fait, toujours pas de PJ attachée a mon mail

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Option Explicit
Dim Ws         As Worksheet
Dim olapp      As Object
Dim sNomPdf As String
Sub InitialisationOutlook()
    On Error Resume Next: Set olapp = GetObject(, "Outlook.Application"): On Error GoTo 0
    If olapp Is Nothing Then Set olapp = CreateObject("Outlook.Application")
End Sub
Sub EnvoiMail(ByVal Sujet As String, ByVal Corps As String, ByVal Destinataire As String, Optional Pj As String = "")
 
    With olapp.CreateItem(0)
        .Subject = Sujet
        .Body = Corps
        .To = Destinataire
        If Pj <> "" Then .Attachments.Add Pj
        .Send
    End With
End Sub
Sub Transmission_Mail()
Dim UnSujet As String, UnDestinataire As String, UnCorps As String, UnePj As String
    InitialisationOutlook
    UnSujet = "Fiche du processus " & Feuil9.Range("A2").Value
    UnDestinataire = Range("B7").Value
    UnCorps = "Le xxx vous transmet la fiche de votre processus." & Chr(13) & Chr(13) & "En cas de désaccord avec les informations transmises, veuillez transmettre les correctifs au plus vite par mail uniquement à l'adresse suivante : xxxxx@gmail.com" & Chr(13) & Chr(13) & "En cas de non réponse de votre part sous 5 jours calendaires, la fiche sera considérée comme correcte." & Chr(13) & Chr(13) & Chr(13) & "Ci-joint la fiche concernant votre processus." & Chr(13) & Chr(13) & Chr(13) & "Respectueusement," & Chr(13) & "L'équipe xxx."
    UnePj = sNomPdf
    Call EnvoiMail(UnSujet, UnCorps, UnDestinataire, UnePj)
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
Private Sub CommandButton2_Click()    ' lancer automatisation du processus
 
'Empeche la fermeture automatique et enregistrement si la macro ci dessous est déclencher
    bBlockShutDown = True
 
    Dim i      As Integer
    Dim j      As Integer
    Dim Trouve As Range
    Dim PlageDeRecherche As Range
    Dim Valeur_Cherchee As String
    Dim AdresseTrouvee As String
    Dim Lig    As Integer
    Dim Col    As Integer
    Dim Processus As String
    Dim Imprim As String
    Dim Mail   As String
    Dim AdrMail As String
    AdrMail = ""
 ' avant l'envoi mail dire - if Mail ="OUI" then...- lancer macro de l'envoi mail
 
    If Mail = "Oui" Then
        'Création du Pdf
        Dim sNomPdf As String
        Dim sDossier As String
        Dim Destinataire As String
 
        sDossier = ThisWorkbook.Path
 
        sNomPdf = sDossier & "\" & "Synthese du processus " & Feuil9.Range("A2") & " _ Extraction du " & _
                  Replace(Replace(Replace(Left(Now, 16), ":", "h"), " ", " à "), "/", "-") & ".pdf"
 
        Feuil9.ExportAsFixedFormat _
                Type:=xlTypePDF, _
                Filename:=sNomPdf, _
                Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, _
                IgnorePrintAreas:=False, _
                OpenAfterPublish:=False
 
 
        'Envoi du mail
        Call Transmission_Mail
 
 
    End If
 
    'Procédure de demande d impression
    If Imprim = "Oui" Then
 
        'ActiveWindow.SelectedSheets.PrintOut Copies:=NbreCopie
        ActiveWindow.SelectedSheets.PrintOut Copies:=1
 
 
    End If
 
 
    ' Reprise de la macro jusqu'à la fin des processus sélectionnés
 
 
 
    'Affichage feuille
    Application.ScreenUpdating = True
 
    'Protection de la feuille
    ActiveSheet.Protect
    Range("A9").Select
End Sub

[joe.levrai]

Regarde la ligne 23 de ta procédure principale

ce n'est pas pour rien que j'ai parlé de "couper" puis "coller" la ligne où ta variable était déclarée pour la placer en haut de ton module


Si tu as deux variables portant le même nom :

- une variable étendue à l'ensemble d'un module
- une variable étendue à une unique procédure

dans la procédure où la variable est déclarée, elle prend "le pas" sur la variable de portée module

tu n'as fais que la moitié de ce que je t'ai invité à faire

[graphikris]

Merci à toi Joe.
Effectivement ça fonctionne.
Tu me sauves