Expanding one picture on two slides

[Nuz]

Can I position a picture on a ppt presentation so that it is shown on two slides? For example, slide 1 should show 50% (the left side) of the picture and the slide 2 would show the rest. I'd not like to cut-and-paste the picture into two pieces and then try to position each piece on both slides to have correct positions.

I am eventually converting the ppt to pdf which is then displayed two pages side by side. I'd like to show the picture positioned in the middle of the view but which lays on two pages.

[TammyC]

Yes sure, you should cut your picture first so you get 2 pictures and only after that you may add them to your slide show. Cut the picture with some picture editor. And than you want have any problems.

[Cosmo]

This should help you get started. The following will duplicate a shape on the first slide named 'Picture 3', and split it into 2 pieces:

Function cropPic()
Dim shapeToCrop As Shape
Dim cropPoints As Long
Dim top As Long
Dim left As Long
Set shapeToCrop = ActivePresentation.Slides(1).Shapes("Picture 3")
left = shapeToCrop.left
top = shapeToCrop.top
cropPoints = shapeToCrop.Width * 0.5
shapeToCrop.PictureFormat.CropLeft = cropPoints
With shapeToCrop.Duplicate
.PictureFormat.CropLeft = 0
.PictureFormat.CropRight = cropPoints
.top = top
.left = left
End With
End Function

[Nuz]

If there is not a "build-in" feature in ppt to position picture on two slides, the VBA solution could then be best.

The code Cosmo provided is a good starting point.

But, the real problem is positioning the pictures eactly correctly on each slide.
Could it be solved through VBA too?

For example:
1) I would initially position the whole picture on slide 1 so that it is partly on the slide and partly outside the slide (on the right side)
2) the VBA should then cut the area which lies outside the slide and position it on the slide 2 (aligned to left side) eactly at the same vertical position than the picture on slide 1.

[John Wilson]

This is a variation on Mark's code.

It will position the picture for you you don't need to have it half off slide.

Select the picture and run see if it works.

Sub cropPic()
Dim osld As Slide
Dim shapeToCrop As Shape
Dim rightcrop As Shape
Dim leftcrop As Shape
Dim cropPoints As Single
Dim sngtop As Single
Dim sngleft As Single
Dim sngwidth As Single
Dim indx As Long
If ActiveWindow.Selection.Type <> ppSelectionShapes Then
MsgBox "Select a picture"
Exit Sub
End If
Set osld = ActiveWindow.View.Slide
Set shapeToCrop = ActiveWindow.Selection.ShapeRange(1)
sngwidth = shapeToCrop.width
shapeToCrop.LockAspectRatio = True
'crop only work correctly is shape is 100% size so do this
shapeToCrop.ScaleWidth 1, True
cropPoints = shapeToCrop.width * 0.5
With shapeToCrop
.PictureFormat.CropLeft = cropPoints
.Name = "RightHalf"
End With
With shapeToCrop.Duplicate
.PictureFormat.CropLeft = 0
.PictureFormat.CropRight = cropPoints
.Name = "LeftHalf"
End With
'put size back to original
osld.Shapes("LeftHalf").width = sngwidth / 2
osld.Shapes("RightHalf").width = sngwidth / 2
'duplicate slide and place and delete relevant shapes
With osld.Duplicate
.Shapes("LeftHalf").Delete
indx = .SlideIndex
With .Shapes("RightHalf")
.top = ActivePresentation.PageSetup.SlideHeight / 2 - .Height / 2
.left = 0
End With
End With
With ActivePresentation.Slides(indx - 1)
.Shapes("RightHalf").Delete
With .Shapes("LeftHalf")
.left = ActivePresentation.PageSetup.SlideWidth - .width
.top = ActivePresentation.PageSetup.SlideHeight / 2 - .Height / 2
End With
End With
End Sub

[Nuz]

Yes, the picture splits perfectly into to slides.
Only thing that I am missing, is that I'd like to be able to position the picture also differently than 50% - 50% on the slides (I explained it probably badly in the initial post). It also should consider where the initial position of the picture was.

The code now always splits the picture to equal pieces and positions them vertically in the middle of the slide. I'd like to retain the original vertical position and also split the picture based on how it is positioned on the first slide (only the portion of the picture that lies outside the first slide is copied to the second slide).

[John Wilson]

Try this then:

Sub cropPic()
Dim osld As Slide
Dim shapeToCrop As Shape
Dim sngtop As Single
Dim sngleft As Single
Dim sngOldW As Single
Dim sngNewW As Single
Dim indx As Long
Dim cropfacL As Single
Dim cropfacR As Single
Dim sldW As Single
Dim sldH As Single

If ActiveWindow.Selection.Type <> ppSelectionShapes Then
MsgBox "Select a picture"
Exit Sub
End If
Set osld = ActiveWindow.View.Slide
sldH = ActivePresentation.PageSetup.SlideHeight
sldW = ActivePresentation.PageSetup.SlideWidth
Set shapeToCrop = ActiveWindow.Selection.ShapeRange(1)
cropfacL = (sldW - shapeToCrop.left) / shapeToCrop.width
cropfacR = 1 - cropfacL
sngOldW = shapeToCrop.width
shapeToCrop.LockAspectRatio = True
shapeToCrop.ScaleWidth 1, True
sngNewW = shapeToCrop.width
With shapeToCrop
.PictureFormat.CropLeft = sngNewW * cropfacL
.Name = "RightHalf"
End With
With shapeToCrop.Duplicate
.PictureFormat.CropLeft = 0
.PictureFormat.CropRight = sngNewW * cropfacR
.Name = "LeftHalf"
End With
osld.Shapes("LeftHalf").width = sngOldW * cropfacL
osld.Shapes("RightHalf").width = sngOldW * cropfacR
With osld.Duplicate
.Shapes("LeftHalf").Delete
indx = .SlideIndex
With .Shapes("RightHalf")
.left = 0
End With
With ActivePresentation.Slides(indx - 1)
.Shapes("RightHalf").Delete
With .Shapes("LeftHalf")
.left = sldW - .width
End With
End With
End With
End Sub

[John Wilson]

That was "air code" and when I tried it surprizingly the images did move down the slide still. This should fix it!

Sub cropPic()
Dim osld As Slide
Dim shapeToCrop As Shape
Dim sngTop As Single
Dim sngleft As Single
Dim sngOldW As Single
Dim sngNewW As Single
Dim indx As Long
Dim cropfacL As Single
Dim cropfacR As Single
Dim sldW As Single
Dim sldH As Single


If ActiveWindow.Selection.Type <> ppSelectionShapes Then
MsgBox "Select a picture"
Exit Sub
End If
Set osld = ActiveWindow.View.Slide
sldH = ActivePresentation.PageSetup.SlideHeight
sldW = ActivePresentation.PageSetup.SlideWidth
Set shapeToCrop = ActiveWindow.Selection.ShapeRange(1)
sngTop = shapeToCrop.Top
cropfacL = (sldW - shapeToCrop.Left) / shapeToCrop.Width
cropfacR = 1 - cropfacL
sngOldW = shapeToCrop.Width
shapeToCrop.LockAspectRatio = True
shapeToCrop.ScaleWidth 1, True
sngNewW = shapeToCrop.Width
With shapeToCrop
.PictureFormat.CropLeft = sngNewW * cropfacL
.Name = "RightHalf"
End With
With shapeToCrop.Duplicate
.PictureFormat.CropLeft = 0
.PictureFormat.CropRight = sngNewW * cropfacR
.Name = "LeftHalf"
End With
osld.Shapes("LeftHalf").Width = sngOldW * cropfacL
osld.Shapes("RightHalf").Width = sngOldW * cropfacR
With osld.Duplicate
.Shapes("LeftHalf").Delete
indx = .SlideIndex
With .Shapes("RightHalf")
.Left = 0
.Top = sngTop
End With
With ActivePresentation.Slides(indx - 1)
.Shapes("RightHalf").Delete
With .Shapes("LeftHalf")
.Left = sldW - .Width
.Top = sngTop
End With
End With
End With
End Sub

[Nuz]

Thank you, it works.

I believe the code works only with pictures?

Is there a way to make it work with all kinds of shapes too?
(in some cases I'd like to put shapes on the picture that has to be splitted similarly).

[John Wilson]

Crop only works with pictures. You would need to cut the shape and paste special as a picture.