Consulting

Results 1 to 2 of 2

Thread: I'm sending slides to email and I want a shape from slide 1 added between each slide

  1. #1

    I'm sending slides to email and I want a shape from slide 1 added between each slide

    I'm using this code to send selected slides into an email message:
    Sub Email_SLIDE_RANGE_Image_and_Notes2()
    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
    The code works great except for the adding of the THICKLINE shape from slide 1 into the email message after each slide.
    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
    Last edited by Aussiebear; 03-06-2023 at 12:28 PM.

  2. #2
    VBAX Regular
    Joined
    May 2018
    Location
    Sydney
    Posts
    57
    Location
    You could try to create an inline image from the "THICKLINE" shape and insert it as an HTML element in the email message?

    Sub Email_SLIDE_RANGE_Image_and_Notes2()    Dim OlApp As Object, OlMail As Object, olMailItem As Variant, WordDoc As Word.Document, sld As Slide
        Dim TempFilePath As String, TempFileName As String, ThickLineImagePath As String
        
        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
        
        ' Save the THICKLINE shape as an image
        TempFilePath = Environ$("temp") & "\"
        TempFileName = "ThickLineImg.png"
        ThickLineImagePath = TempFilePath & TempFileName
        ActivePresentation.Slides(1).Shapes("THICKLINE").Export ThickLineImagePath, ppShapeFormatPNG
        
        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 the THICKLINE shape from the image saved earlier
            OlMail.HTMLBody = OlMail.HTMLBody & "<img src='cid:" & TempFileName & "'><br>"
        Next sld
        
        ' Attach the THICKLINE image to the email
        With OlMail.Attachments.Add(ThickLineImagePath)
            .PropertyAccessor.SetProperty "http://schemas.microsoft.com/mapi/proptag/0x3712001F", TempFileName
        End With
        
        Set OlApp = Nothing
        Set OlMail = Nothing
        Set WordDoc = Nothing
    End Sub
    If you only ever do what you can , you'll only ever be what you are.

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •