Bonjour à tous
J’ai un problème avec mon macro qui me crée automatiquement un email.
Ce macro fonctionnait très bien avant que je change d’ordinateur qui est sous Windows 11.
Maintenant quand je clique sur mon bouton, il rame 3 à 4 minutes avant de créer l’email .
J’ai un ordinateur maintenant qui est beaucoup plus puissant que l’autre et il rame avec la macro.
Est-ce qu’il y a une solution pour arranger ce problème
Merci par avance
Bonsoir,
vous devriez vérifier si toutes les options sont bien cochées dans les références, ou si une et coché et qu’il faut pas.
Vérifier les options outlook dans les références
J’ai eu ce problème dans mon entreprise.
Excel était ralenti à cause du rafraîchissement de l’écran, ça m’a vraiment donné du fil à retordre !
J’ai ajouté une fonction pour désactiver cette option au début de la macro et la réactiver à la fin.
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
J’éspere avoir pu vous apporté une piste
Salutation
Bonjour et merci pour votre réponse
Je ne sais pas quel option il faut cocher ou pas dans excel ou outlook pour les macros
J’ai remarqué aussi que quand j’ouvrais la macro pour la première fois Il mettait trois quatre minutes à exécuter le mail par contre si je ne referme pas le fichier Excel et si j’ ouvre la macro pour la 2e ou 3e fois il réalise le mail aussitôt.
J’ai ajouté votre fonction dans ma macro mais j’ai le même problème.
Pourriez vous me transmettre votre code ?
Sub Ordre_de_mission()
Dim xSht As Worksheet
Dim xFileDlg As FileDialog
Dim xFolder As String
Dim xYesorNo As Integer
Dim xOutlookObj As Object
Dim xEmailObj As Object
Dim xUsedRng As Range
Set xSht = ActiveSheet
xFolder = ThisWorkbook.Path & Application.PathSeparator & Range("J3") & "_" & Range("K2") & "." & "pdf" '/ = mauvais charactère
'xFolder = ThisWorkbook.Path & PathSeparator & xSht.Name
MsgBox "Le fichier a été sauvegardé en PDF dans votre dossier" & vbCrLf & "Ordre de mission." & vbCrLf & vbCrLf & "FH"
Set xUsedRng = xSht.UsedRange
If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then
'Save as PDF file
xSht.ExportAsFixedFormat Type:=xlTypePDF, Filename:=xFolder, Quality:=xlQualityStandard
'Create Outlook email
Set xOutlookObj = CreateObject("Outlook.Application")
Set xEmailObj = xOutlookObj.CreateItem(0)
With xEmailObj
.Display
.To = Range("G1")
.CC = Range("H1")
.Display ' afficher le mail avant de l’envoyer sinon placer send pour envoyer
.Subject = ChrW(&HD83D) & ChrW(&HDE97) & " " & Range("G2") & " : " & ChrW(&HD83D) & ChrW(&HDCDD) & " " & Range("C21") & ", " & ChrW(&HD83D) & ChrW(&HDCC5) & " " & Format(Range("B11").Value, " dddd d mmmm yyyy, ") & ChrW(&H231A) & " " & Range("J18") & "."
.HTMLBody = "<font face=""Arial""><font size=""10px"">" & Range("I1") & vbCrLf & vbCrLf & Range("J1") & Range("K1") & "<br>" & "<br>" & Range("G3") _
& "<br>" & "<br>" & "<U>Objet :</U>" & vbCrLf & vbCrLf & "<font color=#305496>" & ChrW(&HD83D) & ChrW(&HDE97) & " " & Range("G2") & " : " & ChrW(&HD83D) & ChrW(&HDCDD) & " " & vbCrLf & Range("C21") & ", " & ChrW(&HD83D) & ChrW(&HDCC5) & Format(Range("B11").Value, " dddd d mmmm yyyy, ") & ChrW(&H231A) & " " & Range("J18") & ", " & ChrW(&H23F1) & ChrW(&HFE0F) & vbCrLf & vbCrLf & [text(E12,"[hh]:mm")] & "." & "</font>" & "<br>" & "<br>" & "Référence ordre de mission: " & vbCrLf & vbCrLf _
& "<font color=#305496>" & Range("H2") & "</font>" & "<br>" & "<br>" & Range("C6") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("D6") & "</font>" & "<br>" & Range("G11") & "<font color=#305496>" & Range("A6") & "</font>" & "<br>" & Range("A7") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("C7" _
) & "</font>" & "<br>" & Range("A8") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("C8") & "</font>" & "<br>" & Range("A9") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("B9") & "</font>" & "<br>" & "<br>" & Range("D9") & vbCrLf & vbCrLf & "<font color=#305496>" & Format(Range("E9").Value, "dddd d mmmm yyyy") & "</font>" & "<br>" & "<br>" & Range("A11") & _
vbCrLf & vbCrLf & "<font color=#305496>" & Format(Range("B11").Value, "dddd d mmmm yyyy") & " à " & Range("J18") & "</font>" & "<br>" & Range("C11") & vbCrLf & vbCrLf & "<font color=#305496>" & Format(Range("D11").Value, "dddd d mmmm yyyy") & " vers " & Range("J22") & "</font>" & "<br>" & Range("E11") & vbCrLf & vbCrLf & "<font color=#305496>" & vbCrLf & vbCrLf & [text(E12,"[hh]:mm")] & " -> " & Format(Range("E13").Value, "j hh:mm") & "</font>" & "<br>" & "<br>" & Range("A13") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("B13") & "</font>" & "<br>" & Range("C13") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("D13") & "</font>" & "<br>" & "<br>" & _
Range("A14") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("D14") & "</font>" & "<br>" & "<font color=#305496>" & IIf(Range("A15") = "", "", Range("A15") & "<br>") & IIf(Range("A16") = "", "", Range("A16") & "<br>") & IIf(Range("A17") = "", "", Range("A17") & "<br>") & IIf(Range("A18") = "", "", Range("A18") & "<br>") & IIf(Range("A19") = "", "", Range("A19") & "<br>") & "</font>" & "<br>" & Range("A21") & "<font color=#305496>" & " -> " & Range("C21") & "</font>" & "<br>" & "Type de mission : " & _
"<font color=#305496>" & Range("F21") & "</font>" & "<br>" & "<font color=#305496>" & IIf(Range("A22") = "", "", Range("A22") & "<br>") & IIf(Range("A23") = "", "", Range("A23") & "<br>") & "</font>" & "<font color=#305496>" & IIf(Range("A24") = "", "", Range("A24") & "<br>") & IIf(Range("A25") = "", "", Range("A25") & "<br>") & IIf(Range("A26") = "", "", Range("A26") & "<br>") & IIf(Range("A27") = "", "", Range("A27") & "<br>") & IIf(Range("A28") = "", "", Range("A28") & "<br>") & "</font>" & "<br>" & "</font>" & Range("A30") & vbCrLf & vbCrLf & "<font color=#305496>" & vbCrLf & vbCrLf & Range("B30") & "</font>" & "<br>" & Range("D30") _
& vbCrLf & vbCrLf & "<font color=#305496>" & Range("E30") & "</font>" & "<br>" & Range("D31") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("E31") & "</font>" & "<br>" & "Nombre et nom des passagers : " & "<font color=#305496>" & Range("F32") & "<br>" & IIf(Range("G33") = "", "", Range("G33") & "<br>") & "</font>" & "<br>" & Range("B32") & "<br>" & Range("B33") & vbCrLf & vbCrLf & "<font color=#305496>" & vbCrLf & vbCrLf & Format(Range("C33").Value, "-") & "</font>" & "<br>" & Range("B34") & vbCrLf & vbCrLf & "<font color=#305496>" & Format(Range("C34").Value, "0.000 €") _
& "</font>" & "<br>" & Range("A35") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("G36") & "</font>" & "<br>" & "<br>" & Range("A37") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("B37") & " Km" & "</font>" & "<br>" & "<font color=#305496>" & IIf(Range("D37") = "", "", Range("D37") & "<br>") & "</font>" & "<br>" & Range("A39") & "<br>" & Range("A40") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("A41") & " -> " & vbCrLf & vbCrLf & Format(Range("A43").Value, "00.00 €") & "</font>" & "<br>" & Range("B40") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("B41") & "</font>" & "<br>" & Range( _
"C40") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("C41") & "</font>" & "<br>" & Range("D40") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("D41") & "</font>" & "<br>" & Range("E40") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("E41") & "</font>" & "<br>" & Range( _
"F40") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("F41") & "</font>" & "<br>" & Range("B42") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("B43") & "</font>" & "<br>" & Range("C42") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("C43") & "</font>" & "<br>" & Range("D42") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("D43") & "</font>" & "<br>" & Range("E42") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("E43") & "</font>" & "<br>" & Range("F42") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("F43") & "</font>" & "<br>" & "<br>" & Range("H3") & "<br>" & "<br>" & Range("I3") & vbCrLf & .HTMLBody _
.Attachments.Add xFolder
' If DisplayEmail = False Then
'au lieu de vraiment utiliser "Send", on utilise le "Display" et va simuler le raccoursi "CTRL+Enter" d'Outlook, ce qui est le "SEND"
.Display 'no send
DoEvents
Application.Wait (Now + TimeSerial(0, 0, 5)) 'donner un délai à Outlook pour bien préparer le mail
DoEvents
CreateObject("WScript.Shell").SendKeys ("^{Enter}"), True ' "simuler" un raccourci "CTRL+Enter" (ceci n'est pas 100% sûr)
Application.Wait (Now + TimeSerial(0, 0, 2)) 'donner un délai pour l'envoi
DoEvents
' End If
End With
Else
MsgBox " La feuille de calcul active ne peut pas être vide """
Exit Sub
End If
End Sub
A teste :
Sub Ordre_de_mission()
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Dim xSht As Worksheet
Dim xFolder As String
Dim xOutlookObj As Object
Dim xEmailObj As Object
Dim xUsedRng As Range
Set xSht = ActiveSheet
xFolder = ThisWorkbook.Path & Application.PathSeparator & Range(« J3 ») & « _ » & Range(« K2 ») & « .pdf »
Set xUsedRng = xSht.UsedRange
If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then
xSht.ExportAsFixedFormat Type:=xlTypePDF, Filename:=xFolder, Quality:=xlQualityStandard
Set xOutlookObj = CreateObject(« Outlook.Application »)
Set xEmailObj = xOutlookObj.CreateItem(0)
With xEmailObj
.To = « recipient@email.com »
.Subject = « Subject »
.Body = « Body »
.Attachments.Add xFolder
.Display
DoEvents
Application.Wait (Now + TimeSerial(0, 0, 5))
DoEvents
CreateObject(« WScript.Shell »).SendKeys (« ^{Enter} »), True
Application.Wait (Now + TimeSerial(0, 0, 2))
DoEvents
End With
Else
MsgBox « La feuille de calcul active ne peut pas être vide »
End If
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
End Sub
J’ai ajouté votre script au début et à la fin de la macro mais j’ai toujours le même problème
Il faudrait testé le code comme un nouveau code.
Jai essayer sur un fichier vierge , si la feuille active es vide un message box , si non le code enregistre le pdf sur le meme chemin et genere un mail avec les pdf en piece jointe.
Peut etre avec votre fichier cela serai plus facile
Bonjour
je vous joins un fichier mais qui a exactement la même macro que le précédent.
Pour moi il est beaucoup plus facile de partager ce fichier là
Les deux macros que j’ai sur les fichiers ont exactement le même problème pour la création de l’email avec windows 11
Je vous remercie pour le temps que vous prenez à essayer de m’aider
Classeur1.xlsm (61,2 Ko)
bonjour, je ne connais pas autant d’Outlook, mais j’ai testé cette macro dans un boucle et j’arrive chaque fois à environ 8-9 sec, dont 7 sec de « Wait ». Comme il y avait des cellules erronnées dans la feuille « Note de frais », seulement une partie du body sera envoyé vers une adresse avec un « x » en face (apparament, j’ai aussi envoyé quelque mails sans cela).
Le but de cette macro est simplement pour que vous pouvez voir la différence entre vos 7 chronos et les miens. Après cela, ce fichier est pour la poubelle.
Donc, chez moi, je ne vois pas des problèmes et je ne peux pas vous donner un avis.
Classeur1 (29).xlsm (67,5 Ko)
Bonjour
Je pense que tu as un soucis lié à ton environnement informatique propre ce qui explique qu’on ne constate pas ce défaut
Tu devrais intégrer dans le traitement des points d’arrêt (clique au regard de lignes de code dans la colonne de gauche de l’éditeur )
Un point d’arrêt sur la première ligne de celui-ci puis plusieurs autres à intervalle régulier
A l’activation le traitement s’arrêtera au premier par la touche F5 du clavier il progresse de point en point d’arrêt et donc de cerner la partie concernée
Une fois celle-ci déterminée maintien uniquement les 2 points d’arrêt qui l’encadrent puis fais progresser le traitement ligne par ligne par la touche du clavier F8 pour cerner la ou les lignes concernées
Il sera ainsi plus facile en connaissant ces lignes de code d’etablir un diagnostic
C’est à essayer
Bonjour et merci pour votre réponse.
Vis-à-vis de votre Fichier je vois bien la différence mais moi cela mais 2 minutes à 3 minutes pas s’ouvrir.
Je vous remercie quand même de votre aide
Merci pour votre réponse je comprends pas tout mais je vais essayer
Dans l’éditeur de la macro tu mets des points d’arrêt comme ceci :
choisis les lignes sur lesquelles la macro doit s’arrêter un clique dans la colonne à gauche de l’éditeur pour réaliser le point d’arrêt (ligne marron avec un rond de la même couleur dans la colonne)
Un deuxième clique sur le point d’arrêt réalisé le supprime
Puis exécutes ta macro le traitement s’arrête sur le premier point d’arrêt comme ceci :
ligne marron avec un surlignage en jaune
Un appuis sur la touche F5 du clavier relance le traitement jusqu’au point d’arrêt suivant comme ceci :
Avec la touche F8 du clavier le traitement est relancé ligne par ligne comme ceci :
Tu devrais de cette façon cerner la partie qui engendre le délais anormal
Puis de nous la communiquer pour diagnostique
A toi d’oeuvrer
Je ne sais pas si j’ai fait comme il faut mais j’ai mis des points d’arrêt comme tu m’as demandé puis exécuter F5 Puis F8 qui s’est arrêté sur une erreur ci-joint
Réitère plusieurs fois cette manipulation et de vérifier si tu as toujours ce même résultat
Il se peut que cette erreur ne soit que ponctuelle et ne corresponde pas à ton problème de temps d’exécution
Attention la macro doit être exécutée par le bouton pour avoir son onglet actif à l’écran
Mets tes points d’arrêt puis ensuite actives le bouton de la macro pour demarrer le traitement
A chaque arrêt de celui-ci F5 ou F8
Je l’ai répété plusieurs fois et ça fonctionne maintenant je comprends pas mais le principal c’est que cela fonctionne
Je te remercie
Merci pour ce retour positif
Il faut surtout dans ce type de manipulation veiller à ce que le traitement fonctionne avec le bon onglet actif à l écran car sa construction est réalisée en rapport mettre un autre onglet c’est prendre le risque qu’il dysfonctionne car les données de l’onglet actif qui l’utilisera ne seront plus les bonnes
Cette manière d’opérer est un bon moyen pour tester des morceaux de programme afin de les ameliorer et donc d’en faire bénéficier l’ensemble
Si donc le problème est résolu valise ma réponse c’est un plus agréable
Au plaisir une prochaine fois
Ce sujet a été automatiquement fermé après 30 jours. Aucune réponse n’est permise dorénavant.
