I'm using this code to send selected slides into an email message:
Sub Email_SLIDE_RANGE_Image_and_Notes2()The code works great except for the adding of the THICKLINE shape from slide 1 into the email message after each slide.Dim OlApp As Object, OlMail As Object, olMailItem As Variant, WordDoc As Word.document, sld As Slide On Error Resume Next Set OlApp = CreateObject("Outlook.Application") Set OlMail = OlApp.CreateItem(olMailItem) OlMail.htmlbody = "<html><br><br>" '& OlMail.To = "" OlMail.Subject = "..." OlMail.display For Each sld In ActiveWindow.Selection.SlideRange sld.Copy Set WordDoc = OlMail.getinspector.wordeditor WordDoc.Application.Selection.Paste 'add a couple characters after each slide to move the notepage text to beneath the slide image ActivePresentation.Slides(1).NotesPage.Shapes.Placeholders(2).TextFrame.TextRange.Copy WordDoc.Application.Selection.Paste ActivePresentation.Slides(sld.SlideIndex).NotesPage.Shapes(2).TextFrame.TextRange.Copy WordDoc.Application.Selection.Paste 'add a think line shape which is on the presentation's very first slide. ActivePresentation.Slides(1).Shapes("THICKLINE").Copy WordDoc.Application.Selection.Paste Next sld Set OlApp = Nothing Set OlMail = Nothing Set WordDoc = Nothing End Sub
It actually adds the THICKLINE BUT after the code is finished, if there are multiple slides only the last slide has the THICKLINE under it. The other THICKLINES disappear from between the other slides.
Any suggestions?...JD
Reply With Quote
