user_mobilelogo

Word 365: Vous saurez tout !

Pour tout connaître sur Word
Nouvelle version !

600 pages !

9,80 € 

 

En savoir plus.

Voici deux macros qui vont faire ce travail avec Outlook. Ces deux macros font une copie de la présentation et suppriment toutes les diapos qui ne nous intéressent pas. On aurait pu juste faire un copier-coller de la ou des diapos, mais on risque d'avoir un résultat non conforme à l'original du point de vue Mise en forme. Donc, ne prenons pas ce risque.

Cette première macro va envoyer la troisième diapositive de la présentation en cours.

Sub envoi()
'macro écrite par m@rina
Dim chemin As String, x As Integer, nb As Integer
Dim diapo3 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 & "\diapo3.pptx"
diapo3 = chemin & "diapo3.pptx"
Presentations.Open (diapo3)
For x = nb To 1 Step -1
If x <> 3 Then ActivePresentation.Slides(x).Delete
Next
Presentations(diapo3).Save
With monItem
'adresse mail du destinataire
    .To = "destinataire@adresse.fr"
    'sujet du mail
    .Subject = "envoi diapo3"
    'texte du corps du mail
    .body = "Bonjour" & Chr(13& Chr(13& "Je vous prie de bien vouloir trouver blabla"
    .Attachments.Add diapo3
    .Send
End With
Set ol = Nothing
Presentations(diapo3).Close
MsgBox "l'envoi a bien été effectué."
Kill diapo3
End Sub

 

Cette seconde macro va envoyer la dernière diapositive de la présentation en cours.

Sub envoi2()
'macro écrite par m@rina
Dim chemin As String, nb As Integer, x As Integer
Dim p_result 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 & "\result.pptx"
p_result = chemin & "result.pptx"
Presentations.Open (p_result)
For x = nb - 1 To 1 Step -1
ActivePresentation.Slides(x).Delete
Next
Presentations(p_result).Save
With monItem
'adresse mail du destinataire
    .To = "destinataire@adresse.fr"
    'sujet du mail
    .Subject = "envoi dernière diapo"
    'texte du corps du mail
    .body = "Bonjour" & Chr(13& Chr(13& "Je vous prie de bien vouloir trouver blabla"
    .Attachments.Add p_result
    .Send
End With
Set ol = Nothing
Presentations(p_result).Close
MsgBox "l'envoi a bien été effectué."
Kill p_result
End Sub
 

Voir aussi...

Statistiques

Aujourd'hui141
Hier3284
Cette semaine3425
Ce mois141
Total depuis 200412604542

4
visiteurs actuellement en ligne

1 décembre 2020