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

halecs93
  • Question
Microsoft 365 Générer mail via Excel
Réponses
2
Affichages
236
halecs93
halecs93
A
  • Résolu(e)
XL 2021 Macro de création mail de relance avec référence cellules
Réponses
4
Affichages
256
arnoldbrice19
A
G
  • Question
XL 2010 Copier coller une image dans le corps de message via gmail
Réponses
8
Affichages
388
gwenn49
G
D
  • Question
XL 2016 Envoi mail depuis liste déroulante
Réponses
1
Affichages
113
Compte Supprimé 979
C
J
  • Question
XL 2016 envoie mail automatique lors de double-clic sur cellule
Réponses
6
Affichages
260
J@ba
J
Chaton0408
  • Question
Microsoft 365 VBA Création Question liste destinataire
Réponses
6
Affichages
145
youky(BJ)
youky(BJ)
D
  • Question
XL 2013 envoie tableau dans corp du mail vba
2
Réponses
26
Affichages
952
David62800
D
Orson83
  • Résolu(e)
XL 2010 Lien hypertexte mail + message avec saut de ligne
2
Réponses
23
Affichages
835
Staple1600
Staple1600
W
  • Question
Microsoft 365 Fusionne les cellules vides parmi celle avec des valeurs
Réponses
4
Affichages
202
woira95
W
K
  • Résolu(e)
XL 2019 Probleme codage
Réponses
2
Affichages
232
Kevin42560
K

Membres actuellement en ligne

17 membres et 125 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
312 207
Messages
2 086 250
Membres
103 165
dernier inscrit
thithithi78