Jordan_Kai
09-27-2017, 12:54 PM
Hey all,
I am working on a project for a lab that I am.
I found some excellent code that allows me to shuffle the order of a subset of slides. This works great and is very useful.
My goal, however, is to have audio playing over the slides when viewed. But I want this audio to be maintained in the slide position, rather than following the slides as they are shuffled.
Is this possible? Or should I look for a different way to approach this problem.
I have attached the code if that is helpful at all.
----
Sub pseudoCP()
On Error GoTo err
Dim opic As Shape
Dim osld As Slide
Dim newPic As Shape
Dim isPic As Boolean
Dim isTall As Boolean
Set opic = ActiveWindow.Selection.ShapeRange(1)
Set osld = opic.Parent
If opic.Type = msoPicture Then isPic = True
If opic.Type = msoPlaceholder Then
If opic.PlaceholderFormat.ContainedType = msoPicture Then isPic = True
End If
If Not isPic Then
err.Raise Number:=vbObjectError + 1000, Description:="Selection is not a picture"
Exit Sub
End If
If opic.Height >= opic.Width Then isTall = True
Set newPic = osld.Shapes.AddPicture("C:\Users\John\Desktop\Pic1.jpg", msoFalse, msoTrue, 0, 0, -1, -1)
newPic.LockAspectRatio = True 'should already be set but worth checking
If newPic.Height >= newPic.Width And isTall = True Then
newPic.Height = opic.Height
newPic.Top = opic.Top
newPic.Left = opic.Left + opic.Width / 2 - newPic.Width / 2
Else
newPic.Width = opic.Width
newPic.Left = opic.Left
newPic.Top = opic.Top + opic.Height / 2 - newPic.Height / 2
End If
opic.Delete
Exit Sub
err:
MsgBox err.Description
End Sub
---
I am working on a project for a lab that I am.
I found some excellent code that allows me to shuffle the order of a subset of slides. This works great and is very useful.
My goal, however, is to have audio playing over the slides when viewed. But I want this audio to be maintained in the slide position, rather than following the slides as they are shuffled.
Is this possible? Or should I look for a different way to approach this problem.
I have attached the code if that is helpful at all.
----
Sub pseudoCP()
On Error GoTo err
Dim opic As Shape
Dim osld As Slide
Dim newPic As Shape
Dim isPic As Boolean
Dim isTall As Boolean
Set opic = ActiveWindow.Selection.ShapeRange(1)
Set osld = opic.Parent
If opic.Type = msoPicture Then isPic = True
If opic.Type = msoPlaceholder Then
If opic.PlaceholderFormat.ContainedType = msoPicture Then isPic = True
End If
If Not isPic Then
err.Raise Number:=vbObjectError + 1000, Description:="Selection is not a picture"
Exit Sub
End If
If opic.Height >= opic.Width Then isTall = True
Set newPic = osld.Shapes.AddPicture("C:\Users\John\Desktop\Pic1.jpg", msoFalse, msoTrue, 0, 0, -1, -1)
newPic.LockAspectRatio = True 'should already be set but worth checking
If newPic.Height >= newPic.Width And isTall = True Then
newPic.Height = opic.Height
newPic.Top = opic.Top
newPic.Left = opic.Left + opic.Width / 2 - newPic.Width / 2
Else
newPic.Width = opic.Width
newPic.Left = opic.Left
newPic.Top = opic.Top + opic.Height / 2 - newPic.Height / 2
End If
opic.Delete
Exit Sub
err:
MsgBox err.Description
End Sub
---