Je beug sur un macro

VBA
15

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
1 « J'aime »