Dear All,
I am trying to copy all shapes from slides 1 and paste as picture on body of email. Wrote a code but not working. Help will be highly appreciated
I am trying to copy all shapes from slides 1 and paste as picture on body of email. Wrote a code but not working. Help will be highly appreciated
Code:
Sub Email_body()
Dim OutApp As Object
Dim OutMail As Object
Dim pptApp As Object
Dim pptPres As Object
Dim pptSlide As Object
Dim xHTMLBody As String
Dim Allshape As PowerPoint.Shapes
Set pptApp = CreateObject("PowerPoint.Application")
pptApp.Visible = True
pptApp.Activate
Set pptPres = pptApp.ActivePresentation
Set pptSlide = pptPres.Slides(1)
Set Allshape = pptSlide.Shapes
With pptPres
Allshape.SelectAll
.Copy
Debug.Print Allshape
End With
End With
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.Display
.body = ""
With .GetInspector.WordEditor
.Application.Selection.EndKey Unit:=6 '6wdStory
.Application.Selection.TypeParagraph
.Application.Selection.Paste
End With
End With
On Error GoTo 0
Set pptApp = Nothing
Set pptPres = Nothing
Set pptSlide = Nothing
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Last edited by a moderator: