Formulaire

But : Créer un "Formulaire" sur une présentation et envoyer le résultat par courrier

Condition :

Alléger le diaporama au maximum pour qu'il ne soit pas refusé par les serveurs de courrier
- Compresser les images
Le logiciel de messagerie est Outlook pour bureau
Personnaliser le code pour l'adresse du destinataire, le corps du message

Solution :
Faire le formulaire

Il faut un bouton de commande sur la dernière diapositive et des macros

Private Sub CommandButton1_Click()
    'Si l'on souhaite enlever une ou des diapositives dans la présentation
     'ActivePresentation.Slides(4).Delete
    'Mais il y aura encore des choses à faire dans cet exemple sur la dia précédente et suivante
    'pour en garder la cohérence,  prenons ici le parti d'expédier le fichier complet
    Call envoi 'envoi par courrier du fichier
    SlideShowWindows(1).View.GotoSlide (1) 'retour sur la première diapositive
End Sub

Le code d'envoi

Sub envoi()
Dim chemin As String, x As Integer, nb As Integer
Dim unfichier As String
Dim ol As Object, monItem As Object
Set ol = CreateObject("outlook.application")
Set monItem = ol.CreateItem(0)
chemin = ActivePresentation.Path & "\"
nb = ActivePresentation.Slides.Count
ActivePresentation.SaveCopyAs chemin & "\unfichier.pptx"
unfichier = chemin & "unfichier.pptx"
With monItem
'adresse mail du destinataire
     .To = "destinataire@adresse.fr" 'à personnaliser
    'sujet du mail
    .Subject = "envoi d'un fichier"
    'texte du corps du mail
    .body = "Bonjour" & Chr(13) & Chr(13) & "Je vous prie de bien vouloir trouver blabla" 'à personnaliser
    .Attachments.Add unfichier
    .Send
End With
Set ol = Nothing
'Presentations(diapo3).Close
MsgBox "l'envoi a bien été effectué."
Kill unfichier
Call effacer_contenu_formulaire
'Call ajouter_une_diapositive 'plus tard car il faut encore ajouter les boutons de navigation
End Sub

Pour effacer le contenu des diapositives

Sub effacer_contenu_formulaire()
For i = 1 To 3
 ActivePresentation.Slides(1).Shapes("TextBox" & i).OLEFormat.Object.Text = ""
Next
ActivePresentation.Slides(2).Shapes("TextBox1").OLEFormat.Object.Text = ""
For i = 1 To 2
 ActivePresentation.Slides(3).Shapes("TextBox" & i).OLEFormat.Object.Text = ""
Next
ActivePresentation.Slides(5).Shapes("ComboBox1").OLEFormat.Object.Text = ""
For i = 1 To 3
 ActivePresentation.Slides(6).Shapes("CheckBox" & i).OLEFormat.Object.Value = ""
Next
End Sub

Télécharger le fichier Questionnaire PowerPoint avec Firefox car Chrome peut parfois considèrer les macros comme virus

Formulaire

Avertissement