XL 2019 Enlever ligne vide dans e-mail automatique

F

Fabrice16ct

XLDnaute Nouveau
Bonjour à tous
Dans mon mail automatique (macro),qui récupère le texte de deux cellules en Range("A22") et en Range("A23") qui sont parfois vides mais ça me met deux lignes vides dans le corps de mon mail automatique.
Est-ce que vous connaissez une formule pour éviter ces lignes vides dans le mail
Merci par avance
 
Trier par date Trier par votes
vgendron

vgendron

XLDnaute Barbatruc
Comme je n'ai pas outlook, je n'ai pas essayé le code suivant

VB: 
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
     Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

     If xFileDlg.Show = True Then
          xFolder = xFileDlg.SelectedItems(1)
    
     
     Else
          MsgBox " Choisir un dossier dans lequel enregistrer le PDF." & vbCrLf & vbCrLf & " Appuyez sur OK pour quitter. FH", vbCritical, " Doit spécifier le dossier de destination "
          Exit Sub
     
     End If
     
     xFolder = xFolder & "\" & xSht.Name & "_" & Replace(Sheets("Ordre de mission").Range("B11").Value, "/", "-") & "_" & Range("D6") & ".pdf"      '/ = mauvais charactère

     'Check if file already exist
     If Len(Dir(xFolder)) > 0 Then
          xYesorNo = MsgBox(xFolder & vbCrLf & vbCrLf & " le nom du fichier existe déjà. " & vbCrLf & vbCrLf & " Voulez-vous le remplacer ? FH", _
                            vbYesNo + vbQuestion, " File Exists ")
          On Error Resume Next
          If xYesorNo = vbYes Then
               Kill xFolder
          Else
               MsgBox " Si vous ne remplacez pas le PDF existant, je ne peux pas continuer." _
                      & vbCrLf & vbCrLf & " Appuyez sur OK pour quitter. FH", 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. FH", 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("A1")
               .CC = Range("A3")
               .Display                      ' afficher le mail avant de l’envoyer sinon placer send pour envoyer
               .Subject = Range("A5") & " " & Range("C16") & " - Déplacement prévu pour le " & Format(Range("D2"), "dd/mm/yy hh:mm")
               .HTMLBody = "<font face=""Arial""><font size=""10px"">" & "<U>Objet :</U>" & vbCrLf & vbCrLf & "<font color=#305496>" & Range("A5") & vbCrLf & vbCrLf & Range("C16") & vbCrLf & vbCrLf & "- Déplacement prévu pour le " & Format(Range("D2").Value, "dd/mm/yy hh:mm") & "." & "</font>" _
                           & vbCrLf & vbCrLf & "<br>" & "<br>" & Range("D1") & vbCrLf & vbCrLf & Range("E1") & Range("F1") & "<br>" & "<br>" _
                           & vbCrLf & vbCrLf & vbCrLf & vbCrLf & Range("A10") & "<br>" & "<br>" _
                           & vbCrLf & vbCrLf & Range("C6") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("D6") & "</font>" & "<br>" _
                           & vbCrLf & vbCrLf & Range("A7") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("C7") & "</font>" & "<br>" & vbCrLf & vbCrLf & Range("A8") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("C8") & "</font>" & "<br>" _
                           & vbCrLf & vbCrLf & Range("A9") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("B9") & "</font>" & "<br>" & vbCrLf & vbCrLf & Range("D9") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("E9") & "</font>" & "<br>" & "<br>" _
                           & vbCrLf & vbCrLf & Range("A11") & vbCrLf & vbCrLf & "<font color=#305496>" & Format(Range("B11").Value, "dd/mm/yy") & " pour " & Format(Range("B12"), "hh:mm") & "</font>" & "<br>" _
                           & vbCrLf & vbCrLf & Range("C11") & vbCrLf & vbCrLf & "<font color=#305496>" & Format(Range("D11").Value, "dd/mm/yy") & " vers " & Format(Range("D12"), "hh:mm") & "</font>" & "<br>" _
                           & vbCrLf & vbCrLf & Range("E11") & vbCrLf & vbCrLf & "<font color=#305496>" & [text(E12,"[hh]:mm")] & "</font>" & "<br>" & "<br>" & vbCrLf & vbCrLf & Range("A13") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("B13") & "</font>" & "<br>" & vbCrLf & vbCrLf & Range("D13") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("E13") & "</font>" & "<br>" & "<br>" & vbCrLf & vbCrLf & Range("A14") & "<br>" & vbCrLf & vbCrLf & "<font color=#305496>" & Replace(Range("A15").Value, vbLf, "<BR>") & "</font>" & "<br>" & "<br>" & Range("A21") & "<font color=#305496>" & Range("C21") & "</font>" & "<br>" & vbCrLf & IIf(Range("A22") <> "", vbCrLf & "<font color=#305496>" & Range("A22") & "<br>" & vbCrLf, "") & IIf(Range("A23") <> "", vbCrLf & Range("A23") & "</font>" & "<br>" & vbCrLf, "") & vbCrLf & "<font color=#305496>" & Replace(Range("A24").Value, vbLf, "<BR>") & "</font>" & vbCrLf & vbCrLf & "<br>" & "<br>" & Range("A27") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("B27") & "<br>"  _
                           Range("D27") & "</font>" & "<br>" & vbCrLf & vbCrLf & Range("D28") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("E28") & "</font>" & "<br>" & Range("D29") & vbCrLf _
                           & vbCrLf & "<font color=#305496>" & Range("D30") & vbCrLf & vbCrLf & Range("E30") & vbCrLf & vbCrLf & Range("D31") & vbCrLf & vbCrLf & Range("E31") & vbCrLf & vbCrLf & Range("D32") & vbCrLf & vbCrLf & Range("E32") & vbCrLf & vbCrLf & Range("D33") & _
                           vbCrLf & vbCrLf & Range("E33") & "</font>" & "<br>" & vbCrLf & vbCrLf & "<br>" & vbCrLf & vbCrLf & Range("B29") & "<br>" & vbCrLf & vbCrLf & Range("B30") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("C30") & "</font>" & "<br>" & _
                           vbCrLf & vbCrLf & Range("B31") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("C31") & "</font>" & vbCrLf & vbCrLf & "<br>" & vbCrLf & vbCrLf & Range("A32") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("B33") & " Km ->" & vbCrLf & vbCrLf & Format(Range("C33").Value, "00.00") & vbCrLf & vbCrLf & "€" & "</font>" & "<br>" & "<br>" & Range("A34") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("D34") & " Km" & "</font>" & vbCrLf _
                           & vbCrLf & Range("E34") & "<br>" & "<br>" & vbCrLf & Range("B10") & "<br>" & "<br>" & Range("C10") & vbCrLf & .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

End Sub
 
Vote positif 0 Vote négatif
F

Fabrice16ct

XLDnaute Nouveau
VB: 
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
     Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

     If xFileDlg.Show = True Then
          xFolder = xFileDlg.SelectedItems(1)
    
    
     Else
          MsgBox " Choisir un dossier dans lequel enregistrer le PDF." & vbCrLf & vbCrLf & " Appuyez sur OK pour quitter. FH", vbCritical, " Doit spécifier le dossier de destination "
          Exit Sub
    
     End If
    
     xFolder = xFolder & "\" & xSht.Name & "_" & Replace(Sheets("Ordre de mission").Range("B11").Value, "/", "-") & "_" & Range("D6") & ".pdf"      '/ = mauvais charactère

     'Check if file already exist
     If Len(Dir(xFolder)) > 0 Then
          xYesorNo = MsgBox(xFolder & vbCrLf & vbCrLf & " le nom du fichier existe déjà. " & vbCrLf & vbCrLf & " Voulez-vous le remplacer ? FH", _
                            vbYesNo + vbQuestion, " File Exists ")
          On Error Resume Next
          If xYesorNo = vbYes Then
               Kill xFolder
          Else
               MsgBox " Si vous ne remplacez pas le PDF existant, je ne peux pas continuer." _
                      & vbCrLf & vbCrLf & " Appuyez sur OK pour quitter. FH", 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. FH", 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("A1")
               .CC = Range("A3")
               .Display                      ' afficher le mail avant de l’envoyer sinon placer send pour envoyer
               .Subject = Range("A5") & " " & Range("C16") & " - Déplacement prévu pour le " & Format(Range("D2"), "dd/mm/yy hh:mm")
               .HTMLBody = "<font face=""Arial""><font size=""10px"">" & "<U>Objet :</U>" & vbCrLf & vbCrLf & "<font color=#305496>" & Range("A5") & vbCrLf & vbCrLf & Range("C16") & vbCrLf & vbCrLf & "- Déplacement prévu pour le " & Format(Range("D2").Value, "dd/mm/yy hh:mm") & "." & "</font>" _
                           & vbCrLf & vbCrLf & "<br>" & "<br>" & Range("D1") & vbCrLf & vbCrLf & Range("E1") & Range("F1") & "<br>" & "<br>" _
                           & vbCrLf & vbCrLf & vbCrLf & vbCrLf & Range("A10") & "<br>" & "<br>" _
                           & vbCrLf & vbCrLf & Range("C6") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("D6") & "</font>" & "<br>" _
                           & vbCrLf & vbCrLf & Range("A7") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("C7") & "</font>" & "<br>" & vbCrLf & vbCrLf & Range("A8") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("C8") & "</font>" & "<br>" _
                           & vbCrLf & vbCrLf & Range("A9") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("B9") & "</font>" & "<br>" & vbCrLf & vbCrLf & Range("D9") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("E9") & "</font>" & "<br>" & "<br>" _
                           & vbCrLf & vbCrLf & Range("A11") & vbCrLf & vbCrLf & "<font color=#305496>" & Format(Range("B11").Value, "dd/mm/yy") & " pour " & Format(Range("B12"), "hh:mm") & "</font>" & "<br>" _
                           & vbCrLf & vbCrLf & Range("C11") & vbCrLf & vbCrLf & "<font color=#305496>" & Format(Range("D11").Value, "dd/mm/yy") & " vers " & Format(Range("D12"), "hh:mm") & "</font>" & "<br>" _
                           & vbCrLf & vbCrLf & Range("E11") & vbCrLf & vbCrLf & "<font color=#305496>" & [text(E12,"[hh]:mm")] & "</font>" & "<br>" & "<br>" & vbCrLf & vbCrLf & Range("A13") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("B13") & "</font>" & "<br>" & vbCrLf & vbCrLf & Range("D13") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("E13") & "</font>" & "<br>" & "<br>" & vbCrLf & vbCrLf & Range("A14") & "<br>" & vbCrLf & vbCrLf & "<font color=#305496>" & Replace(Range("A15").Value, vbLf, "<BR>") & "</font>" & "<br>" & "<br>" & Range("A21") & "<font color=#305496>" & Range("C21") & "</font>" & "<br>" & vbCrLf & IIf(Range("A22") <> "", vbCrLf & "<font color=#305496>" & Range("A22") & "<br>" & vbCrLf, "") & IIf(Range("A23") <> "", vbCrLf & Range("A23") & "</font>" & "<br>" & vbCrLf, "") & vbCrLf & "<font color=#305496>" & Replace(Range("A24").Value, vbLf, "<BR>") & "</font>" & vbCrLf & vbCrLf & "<br>" & "<br>" & Range("A27") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("B27") & "<br>" _
                           Range("D27") & "</font>" & "<br>" & vbCrLf & vbCrLf & Range("D28") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("E28") & "</font>" & "<br>" & Range("D29") & vbCrLf _
                           & vbCrLf & "<font color=#305496>" & Range("D30") & vbCrLf & vbCrLf & Range("E30") & vbCrLf & vbCrLf & Range("D31") & vbCrLf & vbCrLf & Range("E31") & vbCrLf & vbCrLf & Range("D32") & vbCrLf & vbCrLf & Range("E32") & vbCrLf & vbCrLf & Range("D33") & _
                           vbCrLf & vbCrLf & Range("E33") & "</font>" & "<br>" & vbCrLf & vbCrLf & "<br>" & vbCrLf & vbCrLf & Range("B29") & "<br>" & vbCrLf & vbCrLf & Range("B30") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("C30") & "</font>" & "<br>" & _
                           vbCrLf & vbCrLf & Range("B31") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("C31") & "</font>" & vbCrLf & vbCrLf & "<br>" & vbCrLf & vbCrLf & Range("A32") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("B33") & " Km ->" & vbCrLf & vbCrLf & Format(Range("C33").Value, "00.00") & vbCrLf & vbCrLf & "€" & "</font>" & "<br>" & "<br>" & Range("A34") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("D34") & " Km" & "</font>" & vbCrLf _
                           & vbCrLf & Range("E34") & "<br>" & "<br>" & vbCrLf & Range("B10") & "<br>" & "<br>" & Range("C10") & vbCrLf & .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

End Sub

Cela me trouve des erreurs toute la partie html est en rouge
 
Vote positif 0 Vote négatif
vgendron

vgendron

XLDnaute Barbatruc
il doit y avoir une erreur de syntaxe

l'idée c'est de ne rajouter une ligne QUE si tes cellules A22 et A23 contiennent quelque chose

contenuBody=iif(Range("A22")<>"","contenu de chaine html à rajouter","")
contenuBody=contenuBody & iif(Range("A22")<>"","contenu de chaine html à rajouter","")

msgbox contenuBody
 
Vote positif 0 Vote négatif
F

Fabrice16ct

XLDnaute Nouveau
vgendron à dit:
Comme je n'ai pas outlook, je n'ai pas essayé le code suivant

VB: 
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
     Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

     If xFileDlg.Show = True Then
          xFolder = xFileDlg.SelectedItems(1)
   
    
     Else
          MsgBox " Choisir un dossier dans lequel enregistrer le PDF." & vbCrLf & vbCrLf & " Appuyez sur OK pour quitter. FH", vbCritical, " Doit spécifier le dossier de destination "
          Exit Sub
    
     End If
    
     xFolder = xFolder & "\" & xSht.Name & "_" & Replace(Sheets("Ordre de mission").Range("B11").Value, "/", "-") & "_" & Range("D6") & ".pdf"      '/ = mauvais charactère

     'Check if file already exist
     If Len(Dir(xFolder)) > 0 Then
          xYesorNo = MsgBox(xFolder & vbCrLf & vbCrLf & " le nom du fichier existe déjà. " & vbCrLf & vbCrLf & " Voulez-vous le remplacer ? FH", _
                            vbYesNo + vbQuestion, " File Exists ")
          On Error Resume Next
          If xYesorNo = vbYes Then
               Kill xFolder
          Else
               MsgBox " Si vous ne remplacez pas le PDF existant, je ne peux pas continuer." _
                      & vbCrLf & vbCrLf & " Appuyez sur OK pour quitter. FH", 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. FH", 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("A1")
               .CC = Range("A3")
               .Display                      ' afficher le mail avant de l’envoyer sinon placer send pour envoyer
               .Subject = Range("A5") & " " & Range("C16") & " - Déplacement prévu pour le " & Format(Range("D2"), "dd/mm/yy hh:mm")
               .HTMLBody = "<font face=""Arial""><font size=""10px"">" & "<U>Objet :</U>" & vbCrLf & vbCrLf & "<font color=#305496>" & Range("A5") & vbCrLf & vbCrLf & Range("C16") & vbCrLf & vbCrLf & "- Déplacement prévu pour le " & Format(Range("D2").Value, "dd/mm/yy hh:mm") & "." & "</font>" _
                           & vbCrLf & vbCrLf & "<br>" & "<br>" & Range("D1") & vbCrLf & vbCrLf & Range("E1") & Range("F1") & "<br>" & "<br>" _
                           & vbCrLf & vbCrLf & vbCrLf & vbCrLf & Range("A10") & "<br>" & "<br>" _
                           & vbCrLf & vbCrLf & Range("C6") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("D6") & "</font>" & "<br>" _
                           & vbCrLf & vbCrLf & Range("A7") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("C7") & "</font>" & "<br>" & vbCrLf & vbCrLf & Range("A8") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("C8") & "</font>" & "<br>" _
                           & vbCrLf & vbCrLf & Range("A9") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("B9") & "</font>" & "<br>" & vbCrLf & vbCrLf & Range("D9") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("E9") & "</font>" & "<br>" & "<br>" _
                           & vbCrLf & vbCrLf & Range("A11") & vbCrLf & vbCrLf & "<font color=#305496>" & Format(Range("B11").Value, "dd/mm/yy") & " pour " & Format(Range("B12"), "hh:mm") & "</font>" & "<br>" _
                           & vbCrLf & vbCrLf & Range("C11") & vbCrLf & vbCrLf & "<font color=#305496>" & Format(Range("D11").Value, "dd/mm/yy") & " vers " & Format(Range("D12"), "hh:mm") & "</font>" & "<br>" _
                           & vbCrLf & vbCrLf & Range("E11") & vbCrLf & vbCrLf & "<font color=#305496>" & [text(E12,"[hh]:mm")] & "</font>" & "<br>" & "<br>" & vbCrLf & vbCrLf & Range("A13") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("B13") & "</font>" & "<br>" & vbCrLf & vbCrLf & Range("D13") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("E13") & "</font>" & "<br>" & "<br>" & vbCrLf & vbCrLf & Range("A14") & "<br>" & vbCrLf & vbCrLf & "<font color=#305496>" & Replace(Range("A15").Value, vbLf, "<BR>") & "</font>" & "<br>" & "<br>" & Range("A21") & "<font color=#305496>" & Range("C21") & "</font>" & "<br>" & vbCrLf & IIf(Range("A22") <> "", vbCrLf & "<font color=#305496>" & Range("A22") & "<br>" & vbCrLf, "") & IIf(Range("A23") <> "", vbCrLf & Range("A23") & "</font>" & "<br>" & vbCrLf, "") & vbCrLf & "<font color=#305496>" & Replace(Range("A24").Value, vbLf, "<BR>") & "</font>" & vbCrLf & vbCrLf & "<br>" & "<br>" & Range("A27") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("B27") & "<br>"  _
                           Range("D27") & "</font>" & "<br>" & vbCrLf & vbCrLf & Range("D28") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("E28") & "</font>" & "<br>" & Range("D29") & vbCrLf _
                           & vbCrLf & "<font color=#305496>" & Range("D30") & vbCrLf & vbCrLf & Range("E30") & vbCrLf & vbCrLf & Range("D31") & vbCrLf & vbCrLf & Range("E31") & vbCrLf & vbCrLf & Range("D32") & vbCrLf & vbCrLf & Range("E32") & vbCrLf & vbCrLf & Range("D33") & _
                           vbCrLf & vbCrLf & Range("E33") & "</font>" & "<br>" & vbCrLf & vbCrLf & "<br>" & vbCrLf & vbCrLf & Range("B29") & "<br>" & vbCrLf & vbCrLf & Range("B30") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("C30") & "</font>" & "<br>" & _
                           vbCrLf & vbCrLf & Range("B31") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("C31") & "</font>" & vbCrLf & vbCrLf & "<br>" & vbCrLf & vbCrLf & Range("A32") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("B33") & " Km ->" & vbCrLf & vbCrLf & Format(Range("C33").Value, "00.00") & vbCrLf & vbCrLf & "€" & "</font>" & "<br>" & "<br>" & Range("A34") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("D34") & " Km" & "</font>" & vbCrLf _
                           & vbCrLf & Range("E34") & "<br>" & "<br>" & vbCrLf & Range("B10") & "<br>" & "<br>" & Range("C10") & vbCrLf & .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

End Sub
Cliquez pour agrandir...
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
     Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

     If xFileDlg.Show = True Then
          xFolder = xFileDlg.SelectedItems(1)
    
    
     Else
          MsgBox " Choisir un dossier dans lequel enregistrer le PDF." & vbCrLf & vbCrLf & " Appuyez sur OK pour quitter. FH", vbCritical, " Doit spécifier le dossier de destination "
          Exit Sub
    
     End If
    
     xFolder = xFolder & "\" & xSht.Name & "_" & Replace(Sheets("Ordre de mission").Range("B11").Value, "/", "-") & "_" & Range("D6") & ".pdf"      '/ = mauvais charactère

     'Check if file already exist
     If Len(Dir(xFolder)) > 0 Then
          xYesorNo = MsgBox(xFolder & vbCrLf & vbCrLf & " le nom du fichier existe déjà. " & vbCrLf & vbCrLf & " Voulez-vous le remplacer ? FH", _
                            vbYesNo + vbQuestion, " File Exists ")
          On Error Resume Next
          If xYesorNo = vbYes Then
               Kill xFolder
          Else
               MsgBox " Si vous ne remplacez pas le PDF existant, je ne peux pas continuer." _
                      & vbCrLf & vbCrLf & " Appuyez sur OK pour quitter. FH", 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. FH", 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("A1")
               .CC = Range("A3")
               .Display                      ' afficher le mail avant de l’envoyer sinon placer send pour envoyer
               .Subject = Range("A5") & " " & Range("C16") & " - Déplacement prévu pour le " & Format(Range("D2"), "dd/mm/yy hh:mm")
               .HTMLBody = "<font face=""Arial""><font size=""10px"">" & "<U>Objet :</U>" & vbCrLf & vbCrLf & "<font color=#305496>" & Range("A5") & vbCrLf & vbCrLf & Range("C16") & vbCrLf & vbCrLf & "- Déplacement prévu pour le " & Format(Range("D2").Value, "dd/mm/yy hh:mm") & "." & "</font>" _
                           & "<br>" & "<br>" & Range("D1") & vbCrLf & vbCrLf & Range("E1") & Range("F1") & "<br>" & "<br>" & Range("A10") & "<br>" & "<br>" & Range("C6") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("D6") & "</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>" & Range("D9") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("E9") & "</font>" _
                           & "<br>" & "<br>" & Range("A11") & vbCrLf & vbCrLf & "<font color=#305496>" & Format(Range("B11").Value, "dd/mm/yy") & " pour " & Format(Range("B12"), "hh:mm") & "</font>" _
                           & "<br>" & Range("C11") & vbCrLf & vbCrLf & "<font color=#305496>" & Format(Range("D11").Value, "dd/mm/yy") & " vers " & Format(Range("D12"), "hh:mm") & "</font>" _
                           & "<br>" & Range("E11") & vbCrLf & vbCrLf & "<font color=#305496>" & [text(E12,"[hh]:mm")] & "</font>" & "<br>" & "<br>" & Range("A13") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("B13") & "</font>" & "<br>" & Range("D13") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("E13") & "</font>" & "<br>" _
                           & "<br>" & Range("A14") & "<br>" & "<font color=#305496>" & Replace(Range("A15").Value, vbLf, "<BR>") & "</font>" & "<br>" & "<br>" & Range("A21") & "<font color=#305496>" & Range("C21") & "</font>" & "<br>" _
                           & "<font color=#305496>" & Range("C21") & "</font>" & "<br>" & vbCrLf & IIf(Range("A22") <> "", vbCrLf & "<font color=#305496>" & Range("A22") & "<br>" & vbCrLf, "") & IIf(Range("A23") <> "", vbCrLf & Range("A23") & "</font>" & "<br>" & vbCrLf, "") & "<br>" & "<font color=#305496>" & Replace(Range("A24").Value, vbLf, "<BR>") & "</font>" & "<br>" & "<br>" & Range("A27") & vbCrLf & vbCrLf & "<font color=#305496>" & vbCrLf & vbCrLf & Range("B27") & "<br>" & Range("D27") & "</font>" & "<br>" _
                           & Range("D28") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("E28") & "</font>" & "<br>" & Range("D29") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("D30") & vbCrLf & vbCrLf & Range("E30") & vbCrLf & vbCrLf & Range("D31") & vbCrLf & vbCrLf & Range("E31") & vbCrLf & vbCrLf & Range("D32") & vbCrLf & vbCrLf & Range("E32") & vbCrLf & Range("D33") & vbCrLf & vbCrLf & Range("E33") & "</font>" & "<br>" _
                           & "<br>" & Range("B29") & "<br>" & Range("B30") & vbCrLf & vbCrLf & "<font color=#305496>" & vbCrLf & vbCrLf & Range("C30") & "</font>" & "<br>" & Range("B31") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("C31") & "</font>" & "<br>" _
                           & Range("A32") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("B33") & " Km ->" & vbCrLf & vbCrLf & Format(Range("C33").Value, "00.00") & vbCrLf & vbCrLf & "€" & "</font>" & "<br>" & "<br>" & Range("A34") & vbCrLf & vbCrLf & "<font color=#305496>" & Range("D34") & " Km" & "</font>" & vbCrLf & vbCrLf & Range("E34") & "<br>" _
                           & "<br>" & Range("B10") & "<br>" & "<br>" & Range("C10") & vbCrLf & .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

End Sub

J'ai nettoyé mon script parce qu'il était très confus après j'ai ajouté ton code sur mes deux cellules il n'y a plus d'erreur par contre au niveau de mon mail c'est tout décalé
 
Vote positif 0 Vote négatif

Discussions similaires

B
  • Question
XL 2016 VBA - Ajout de consignes dans le corps d'un mail
Réponses
3
Affichages
208
kiki29
kiki29
J
  • Résolu(e)
XL 2013 Créer une macro avec un fichier pour envoyer par mail
Réponses
7
Affichages
342
TooFatBoy
TooFatBoy
S
  • Résolu(e)
Microsoft 365 Envoi de la signature de l'utilisateur macro envoi de mail
Réponses
3
Affichages
212
spike29
S
zayab
  • Question
Insérer une ligne vide à chaque cellule non vide
Réponses
2
Affichages
178
sylvanu
sylvanu
M
  • Question
Microsoft 365 Récuperation données + envoi mail
Réponses
1
Affichages
271
Oneida
Oneida
A
  • Résolu(e)
XL 2016 Insérer les valeurs de 2 cellules dans l'objet d'un mail
Réponses
5
Affichages
284
Al1_44
A
S
  • Question
XL 2016 Caractère fantôme invisible dans cellule vide non vide.
Réponses
5
Affichages
319
SurfingJoe
S
halecs93
  • Question
Microsoft 365 Générer mail via Excel
Réponses
2
Affichages
671
halecs93
halecs93
C
  • Question
Microsoft 365 Intégrer une image au milieu d'un mail créé via Excel VBA
Réponses
14
Affichages
509
patricktoulon
patricktoulon
R
  • Résolu(e)
Microsoft 365 Extraction contenu mail outlook vers excel
2
Réponses
18
Affichages
1 K
raf26
R

Membres actuellement en ligne

Aucun membre en ligne actuellement.
0 membres et 36 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
315 194
Messages
2 117 157
Membres
113 023
dernier inscrit
bilal h