TPE
Tavvafi@gmail.com |
≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡
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