TPE

[e-mail]

---

≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡

Sub ImportAndCenter()
' Imports an image of each slide in a source presentation into the target presentation
' sizes it appropriately and centers it
' Run this with two presentations open
' The presentation you want to import INTO should be the active presentation

    Dim oSourcePres As Presentation
    Dim otargetPres As Presentation
    Dim oSourceSlide As Slide
    Dim otargetSlide As Slide
    Dim oSh As Shape
    Dim dSafeMargin As Double

    ' EDIT THIS IF YOU LIKE:
    ' This forces the pasted slide to be a bit smaller than the slide you're pasting into
    dSafeMargin = 18    ' margin is in points; 72 points to the inch
                        ' and will be added both top and bottom

    If Presentations.Count <> 2 Then
        MsgBox "You should have two and only two presentations open before running this macro."
        Exit Sub
    End If

    Set otargetPres = ActivePresentation
    If Presentations(1).Name = otargetPres.Name Then
        Set oSourcePres = Presentations(2)
    Else
        Set oSourcePres = Presentations(1)
    End If

    ' Test
    Debug.Print otargetPres.Name
    Debug.Print oSourcePres.Name

    For Each oSourceSlide In oSourcePres.Slides
        Set otargetSlide = otargetPres.Slides.Add(otargetPres.Slides.Count + 1, ppLayoutBlank)
        oSourceSlide.Copy
        Set oSh = otargetSlide.Shapes.PasteSpecial(ppPasteEnhancedMetafile)(1)

        ' maintain shape's aspect ratio
        oSh.LockAspectRatio = msoTrue

        With otargetPres.PageSetup
            ' match pasted shape to new slide's height
            ' this assumes pasting from a "normal" aspect ratio slide
            ' into a wider than normal one
            oSh.height = .Slideheight - (dSafeMargin * 2)


            ' if going the other way, comment out the above and uncomment this
            'osh.width = .Slidewidth

            ' center the shape
            oSh.Left = (.Slidewidth - oSh.width) / 2
            oSh.Top = (.Slideheight - oSh.height) / 2

        End With
    Next

End Sub

---