Microsoft 365 envoyer un formulaire par e-mail

'--------------------------------
'Copy a UserForm to an image file
'--------------------------------

'Arguments:
'---------
'
'- UserForm     : a displayed and active UserForm
'- FullFilePath : the FullFilePath that must include the folder and the image file extension (jpg, gif, ...)
'
'Examples:
'--------
'Call UserFormToImageToFile(Me, "D\Temp\Image10.jpg")
'Call UserFormToImageToFile(UserForm1, "F:\Téléchargements\Test.jpg")
'--------------------------------
Sub UserFormToImageToFile(UserForm As Object, FullFilePath As String)

Sub OLK_Mail(Destinataire$, Objet$, Corps$, NomFich$)
     'Envoi du mail par Outlook
     Dim OlkApp As Object, OlkMail As Object
     Set OlkApp = CreateObject("Outlook.Application")
     Set OlkMail = OlkApp.CreateItem(0)
    
     On Error Resume Next
     With OlkMail
          .To = Destinataire
          .CC = ""
          .BCC = ""
          .Subject = Objet
          .Body = Corps
          .Attachments.Add NomFich
          .Send
     End With
     On Error GoTo 0
    
     OlkApp.Quit
     Set OlkMail = Nothing
     Set OlkApp = Nothing
End Sub

'********************************
'Envoi e-mail en automatique
'********************************
Private Sub mailanom_Click()

     Dim Destinataire$, Objet$, Corps$, NomFichier$
     If CDbl(Me.n°fiche) > WorksheetFunction.Max(Source.[_t_sources[N° Fiche]]) Then MsgBox "Enregistrez d'abord la fiche !": Exit Sub
     'Remplir la fiche d'anomalie à partir du formulaire
     With FicheAno
          .[_f_n°.fiche] = CDbl(Me.n°fiche)
          .[_f_date.émission] = DateValue(Me.dateemission)
          .[_f_réceptionnaire] = Me.receptionnaire
          .[_f_date.réception] = DateValue(Me.datereception)
           ......
          .[_f_valideur] = Me.nomvalid
          .[_f_type.document] = Me.typdoc
          .[_f_n°.document.sage] = Me.numsage
          .[_f_commentaire] = "Commentaires : " & Me.comments
     End With
    
     'Eléments du mail
     Objet = "Anomalie de réception N°" & Me.n°fiche
     Corps = "Bonjour," & vbCrLf & vbCrLf & _
             "Veuillez trouver ci-joint la fiche d'anomalie de réception n°" & Me.n°fiche & "." & vbCrLf & vbCrLf & _
             "Cordialement" & vbCrLf & vbCrLf & _
             Me.nomvalid
    
     NomFichier = Environ$("temp") & "\Fiche anomalie réception n°" & Me.n°fiche & ".pdf"
     Application.DisplayAlerts = False
     FicheAno.[_f_Fiche.Anomalie.Réception].ExportAsFixedFormat Type:=xlTypePDF, Filename:=NomFichier, _
                                                                Quality:=xlQualityStandard, IncludeDocProperties:=False, OpenAfterPublish:=False
     With FicheAno
          .[_f_n°.fiche] = ""
          .[_f_date.émission] = ""
          .[_f_réceptionnaire] = ""
          .[_f_date.réception] = ""
          ......
          .[_f_n°.document.sage] = ""
          .[_f_commentaire] = "Commentaires : "
     End With
    

    'Destinataire à paramétrer !
     Destinataire = "xxxxx@yyyyyy.com"
     OLK_Mail Destinataire, Objet, Corps, NomFichier
    
     Kill NomFichier
    
End Sub

'**************************************
'Ajout de la nouvelle anomalie
'**************************************
Private Sub ajoutbase_Click()
     Dim dEmiss, dRécep, DCtrl, DRéal, TxAno, QtRécep, QtAno
     If WorksheetFunction.Max(Source.[_t_sources[N° Fiche]]) >= CDbl(Me.n°fiche) Then MsgBox "La fiche est déjà enregistrée !": Exit Sub
     If dateemission = "" Then dEmiss = "" Else dEmiss = DateValue(dateemission)
     If datereception = "" Then dRécep = "" Else dRérep = DateValue(datereception)
     If datcontrole = "" Then DCtrl = "" Else DCtrl = DateValue(datcontrole)
     If datrel = "" Then DRéal = "" Else DRéal = DateValue(datrel)
     If tauxanom = "" Then TxAno = "" Else TxAno = Evaluate(Replace(tauxanom, ",", "."))
     If qterecep = "" Then QtRécep = "" Else QtRécep = CDbl(qterecep)
     If qteanom = "" Then QtAno = "" Else QtAno = CDbl(qteanom)
     With Source
          tb = Array(CDbl(n°fiche), dEmiss, receptionnaire, dRécep, frspresta, transporteur, typano, acceptmarch, _
                     refarticle, design, lot, ddmdluo, DCtrl, QtRécep, QtAno, TxAno, numsage, typeanom, action, _
                     DRéal, nomvalid, typdoc, numdoc, comments)
          
          If .[_t_sources[N° Fiche]].Cells(.[_t_sources[N° Fiche]].Rows.Count) <> "" Or .[_t_sources].ListObject.ListRows.Count = 0 Then .[_t_sources].ListObject.ListRows.Add
          
          With .[_t_sources].ListObject
               .ListRows(.ListRows.Count).Range.Value = tb
          End With
     End With
     
     MsgBox " Votre anomalie réception a bien été enregistrée dans la base de données", vbOKOnly + vbInformation, "CONFIRMATION"
End Sub

Private Sub refarticle_Change()
     Idx = Me.refarticle.ListIndex
     If Idx <> -1 Then
          Me.design = Listes.[_t_designation].Cells(Idx + 1)
     Else
          Me.design = ""
     End If
End Sub

Private Sub qteanom_Change()
     If IsNumeric(Me.qterecep) And Me.qterecep <> 0 And IsNumeric(Me.qteanom) Then
          Me.tauxanom = Format(CDbl(Me.qteanom) / CDbl(Me.qterecep), "0.0%")
     Else
          Me.tauxanom = ""
     End If
End Sub

Private Sub qterecep_Change()
     If IsNumeric(Me.qterecep) And Me.qterecep <> 0 And IsNumeric(Me.qteanom) Then
          Me.tauxanom = Format(CDbl(Me.qteanom) / CDbl(Me.qterecep), "0.1%")
     Else
          Me.tauxanom = ""
     End If
End Sub