Bonjour à tous
Voilà j’ai un petit problème avec un macro sous Excel . Je suis complètement novice là-dessus j’ai trouvé sur internet un code qui m’intéressait, que j’ai mis à ma sauce par contre maintenant j’aimerais que quand j’envoie un mail le fichier qui est envoyé automatiquement garde le nom de l’onglet comme actuellement mais j’aimerais en plus que le numéro qui est en cellule J4 soit ajouté automatique au nom du fichier joint.
Je sais que c’est sur cette ligne mais je n’y arrive pas !
xFolder = xFolder + "" + xSht.Name + « .pdf »
Merci pour votre aide.
Sub Envoyer_par_E_mail()
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
Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
If xFileDlg.Show = True Then
xFolder = xFileDlg.SelectedItems(1)
Else
MsgBox « Vous devez spécifier un dossier dans lequel enregistrer le PDF. » & vbCrLf & vbCrLf & « Appuyez sur OK pour quitter. », vbCritical, « Doit spécifier le dossier de destination »
Exit Sub
End If
xFolder = xFolder + "" + xSht.Name + « .pdf »
'Check if file already exist
If Len(Dir(xFolder)) > 0 Then
xYesorNo = MsgBox(xFolder & " Le nom du fichier existe déjà." & vbCrLf & vbCrLf & « Voulez-vous l’écraser? », _
vbYesNo + vbQuestion, « File Exists »)
On Error Resume Next
If xYesorNo = vbYes Then
Kill xFolder
Else
MsgBox « Si vous n’écrasez pas le PDF existant, je ne peux pas continuer. » _
& vbCrLf & vbCrLf & « Appuyez sur OK pour quitter. », vbCritical, « Quitter »
Exit Sub
End If
If Err.Number <> 0 Then
MsgBox « Impossible de supprimer le fichier existant. Veuillez vous assurer que le fichier n’est pas ouvert ou protégé en écriture. » _
& vbCrLf & vbCrLf & « Appuyez sur OK pour quitter. », vbCritical, « Impossible de supprimer le fichier »
Exit Sub
End If
End If
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("G7")
.CC = ""
.Display ‹ afficher le mail avant de l’envoyer sinon placer send pour envoyer
.Subject = Range(« F9 ») + " - N° " + Range(« J4 »)
.HTMLBody = « <font face= »« Arial »« ><font size= »« 14px »« > » & vbCrLf & vbCrLf & « Bonjour, » & « » & « » & vbCrLf & vbCrLf & "Merci de bien vouloir me chiffrer un devis de fourniture pour l’atelier peinture / sol souple, avec en pièce jointe une demande de devis détaillé N° " & Range(« J4 ») & « . » & « » _
& « » _
& vbCrLf & vbCrLf & "INTITULER DE L ›" & Range(« E7 ») & « » _
& « » & vbCrLf & vbCrLf & « Je reste à disposition pour tout renseignement complémentaire. » & « » & « » & vbCrLf & vbCrLf & « Bonne réception. » & « » _
& .HTMLBody
.Attachments.Add xFolder
If DisplayEmail = False Then
'.Send
End If
End With
Else
MsgBox « La feuille de calcul active ne peut pas être vide »
Exit Sub
End If
Pour associer des éléments entre eux ce n’est pas un + mais un &
Donc je persite et signe il faut mettre comme ceci pas d’autre choix :
```xFolder = xFolder & "" & xSht.Name & ".pdf"
Si malgré tout il y a un bug cette adaptation n’est pas à remettre en cause il faut chercher dans le code son origine mais difficile de trouver sans l’intégralité du fichier
Désolé
il y a une procedure pour sursauter cela, mais je ne sais pas vous expliquer en français.
Sub Envoyer_par_E_mail()
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
Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
If xFileDlg.Show = True Then
xFolder = xFileDlg.SelectedItems(1)
Else
MsgBox " Vous devez spécifier un dossier dans lequel enregistrer le PDF. " & vbCrLf & vbCrLf & " Appuyez sur OK pour quitter. ", vbCritical, " Doit spécifier le dossier de destination "
Exit Sub
End If
xFolder = xFolder & "\" & xSht.Name & "_" & Replace(Sheets("Demande de devis").Range("J4").Value, "/", "_") & ".pdf" '/ = mauvais charactère
'Check if file already exist
If Len(Dir(xFolder)) > 0 Then
xYesorNo = MsgBox(xFolder & " Le nom du fichier existe déjà." & vbCrLf & vbCrLf & " Voulez-vous l’écraser? ", _
vbYesNo + vbQuestion, " File Exists ")
On Error Resume Next
If xYesorNo = vbYes Then
Kill xFolder
Else
MsgBox " Si vous n’écrasez pas le PDF existant, je ne peux pas continuer. " _
& vbCrLf & vbCrLf & " Appuyez sur OK pour quitter. ", vbCritical, " Quitter "
Exit Sub
End If
If Err.Number <> 0 Then
MsgBox " Impossible de supprimer le fichier existant. Veuillez vous assurer que le fichier n’est pas ouvert ou protégé en écriture. " _
& vbCrLf & vbCrLf & " Appuyez sur OK pour quitter. ", vbCritical, " Impossible de supprimer le fichier "
Exit Sub
End If
End If
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("G7")
.CC = ""
.Display ' afficher le mail avant de l’envoyer sinon placer send pour envoyer
.Subject = Range(" F9 ") + " - N° " + Range(" J4 ")
.HTMLBody = " <font face= "" Arial "" ><font size= "" 14px "" ><br><br> Bonjour, " & _
"<br><br>Merci de bien vouloir me chiffrer un devis de fourniture pour l’atelier peinture / sol souple, avec en pièce jointe une demande de devis détaillé <strong>N° " & Range(" J4 ") & "</strong>." _
& "<br><br>INTITULER DE L ›<strong>" & Range(" E7 ") & "</strong>" & _
"<br><br>Je reste à disposition pour tout renseignement complémentaire. <br><br> Bonne réception. "
.Attachments.Add xFolder
If DisplayEmail = False Then
'.Send
End If
End With
Else
MsgBox " La feuille de calcul active ne peut pas être vide """
Exit Sub
End If
End Sub
Ton fichier ne possède aucune Macro
J’ai malheuresement été contraint de la créer et d’inclure ton code en corrigeant les caractères impropres liés à l’écriture dans ton message qu’engendre ce forum
Après mise en place à déplorer ceci :
xFolder = xFolder & « » & xSht.Name & « .pdf »
Le chemin du répertoire sélectionné associé au fichier pdf à utiliser doit impérativement être séparé par le symbole antislash comme ceci
xFolder = xFolder & "\" & xSht.Name & ".pdf"
ici
xFolder & "\" & xSht.Name
Une fois ce caractère rajouté l’exécution de la procédure se déroule correctement jusqu’à la partie concernant la réalisation du mail proprement dit :
Set xOutlookObj = CreateObject(« Outlook.Application »)
Set xEmailObj = xOutlookObj.CreateItem(0)
With xEmailObj
etc…
Tout fonctionne correctement avant cette partie aucun bug
Je ne peux poursuivre sur cette seconde partie n’ayant pas sur mon PC d’application de messagerie
C’est à toi d’essayer et me dire après avoir corrigé la ligne de code :
Super merci cela fonctionne. C’est génial. Merci beaucoup !!!
Par contre je ne comprends pas, mais cela me le faisait avant, quand je clique sur la macro de la petite enveloppe, la boîte de dialogue s’ouvre et je vais choisir le dossier spécifique pour l’enregistrement de mon fichier. Une fois que mon dossier est ouvert pour pouvoir faire mon enregistrement, comment cela se fait que dans cette boîte de dialogue je ne vois pas les autres dossiers enregistrer.
Exemple:
Demande de devis_001-21112022_23
Demande de devis_002-22112022_23 etc…
Aussi je vais profiter de votre bonté.
Est-ce que le fichier joint Pdf (ex: Demande de devis_002-22112022_23) qui se crée automatiquement pour l’envoi de l’email peut être enregistré directement dans son dossier?
vous demandez le chemin ( avec Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
donc c’est normal que vous ne voyez pas le contenu devotre répertoire. (si vous voulez voire cela, c’et plutôt avec application.GetOpenFilename).
L’autre question, vous voulez sauvegarder un copie du pdf dans un autre répertoire, alors le chemin serait quoi ? Y-a-t-il quelque chose de logique dans ce chemin ?