Macro to Resize/Position Pictures, Update Links & send to back, and save as PDF

[Baiano42]

Greetings,

We use PPT for our reporting, and I am trying to find a way to expedite our reporting process. Currently, I have designed a Excel that I can import as an object to automate names, equations, etc. However, I need to insert shapes to cover up the extra text it leaves for the different parts of the report.

My problem/question: I need to have my macro adjust only the pictures in slide 2 to the below size and position, then only the pictures in every other slide to the larger size and position. Next, I need the Excel linked objects to be sent to back and update the links. If there is any way to do something like the excel function in PPT like this one
Application.ScreenUpdating = False, that would be ideal as well. Lastly, I would like for it to go ahead and open the "Save As-PDF" window.

Thank you in advance for your time! Here is what I have at the present time:

Sub FinalizeReport()


Dim opic As Shape
Dim osld As Slide
For Each osld In ActivePresentation.Slides
For Each opic In osld.Shapes
If opic.Type = msoPicture Then


Dim opic As Shape
Dim osld As Slide
For Each osld In ActivePresentation.Slides
For Each opic In osld.Shapes
If opic.Type = msoPicture Then
With opic
.Left = 7.2
.Top = 40
.LockAspectRatio = msoFalse
.Width = 705.6
.Height = 305
.Line.ForeColor.RGB = RGB(99, 102, 106)
.Line.Weight = 1
.ZOrder (msoSendToBack)
End With
End If
Next opic
Next osld
Function cm2Points(inVal As Single)
cm2Points = inVal * 28.346
End Function


ActivePresentation.Slides(2).Select
With ActiveWindow.opic
.LockAspectRatio = msoFalse
.Height = 306.72
.Width = 195.12
.Left = 409.68
.Top = 40.32
.ZOrder (msoSendBackward)
.Line.Weight = 1
.Line.ForeColor.RGB = RGB(99, 102, 106)
End With


Dim osld As Slide
Dim oshp As Shape
For Each osld In ActivePresentation.Slides
For Each oshp In osld.Shapes
If oshp.Type = msoLinkedOLEObject Then oshp.LinkFormat.Update
If oshp.Type = msoLinkedOLEObject Then .ZOrder (msoSendToBack)
Next oshp
Next osld
End Function


End Sub

[Baiano42]

I tried adjust ting the macro to the following, but was still unable to get it to work:

Sub picsize()


ActivePresentation.Slides(2).Select
With ActiveWindow.opic
.LockAspectRatio = msoFalse
.Height = 306.72
.Width = 195.12
.Left = 409.68
.Top = 40.32
.ZOrder (msoSendBackward)
.Line.Weight = 1
.Line.ForeColor.RGB = RGB(99, 102, 106)
End With


ActivePresentation.Slides.Range (Array(3, 4, 5, 6, 7))


Dim opic As Shape
Dim osld As Slide
For Each osld In ActivePresentation.Slides
For Each opic In osld.Shapes
If opic.Type = msoPicture Then
With opic
.Left = 7.2
.Top = 40
.LockAspectRatio = msoFalse
.Width = 705.6
.Height = 305
.Line.ForeColor.RGB = RGB(99, 102, 106)
.Line.Weight = 1
.ZOrder (msoSendToBack)
End With
End If
Next opic
Next osld
Function cm2Points(inVal As Single)
cm2Points = inVal * 28.346
End Function


Dim osld As Slide
Dim oshp As Shape
For Each osld In ActivePresentation.Slides
For Each oshp In osld.Shapes
If oshp.Type = msoLinkedOLEObject Then oshp.LinkFormat.Update
If oshp.Type = msoLinkedOLEObject Then .ZOrder (msoSendToBack)
Next oshp
Next osld
End Function


End Function

Help would be greatly appreciated.

[Baiano42]

After digging in further in other threads, I think that I was able to refine the code a little more, and it is able to run without any errors. However, it still doesn't adjust the pictures as I need it to, it just updates the links in the ppt. What am I missing that is keeping it from updating my pictures/images?
Here's the latest code:


Sub Update_Images()

Dim opic As Shape
Dim nn As Integer


'Updates the picture in slide 2 to desired shape/size/position
For Each opic In ActivePresentation.Slides(2).Shapes
If opic.Type = msoPicture Then
With opic
.LockAspectRatio = msoFalse
.Height = 306.72
.Width = 195.12
.Left = 409.68
.Top = 40.32
.ZOrder (msoSendBackward)
.Line.Weight = 1
.Line.ForeColor.RGB = RGB(99, 102, 106)
End With
Else 'do nothing
End If
Next


'Code designed for slides 3-9 where if there is a picture, then it'll adjust pictures to desired shape/size/position, & if there aren't any pictures, it moves on to next slide/part of macro.
For nn = 3 To 9
For Each opic In ActivePresentation.Slides(nn).Shapes
If opic.Type = msoPicture Then
With opic
.Left = 7.2
.Top = 40
.LockAspectRatio = msoFalse
.Width = 705.6
.Height = 305
.Line.ForeColor.RGB = RGB(99, 102, 106)
.Line.Weight = 1
.ZOrder (msoSendToBack)
End With
Else 'do nothing
End If
Next
Next


'Updates links in Powerpoint as needed, but is there a way to send them to back?
Dim osld As Slide
For Each osld In ActivePresentation.Slides
For Each opic In osld.Shapes
If opic.Type = msoLinkedOLEObject Then opic.LinkFormat.Update
Next opic
Next osld


End Sub

[John Wilson]

Checking that the shape type is msoPicture will not work if the picture is in a placeholder.

Check for a Placeholder and then check it's ContainedType for msoPicture.


Sub FinalizeReport()
Dim opic As Shape
Dim osld As Slide
For Each osld In ActivePresentation.Slides
For Each opic In osld.Shapes
If isPic(opic) Then
Select Case osld.SlideIndex
Case Is = 2
'set slide 2 size
Case Is > 2
'set size for these
End Select
End If ' is a picture
End Sub


Function isPic(oshp As Shape) As Boolean
If oshp.Type = msoPicture Then
isPic = True
Exit Function
End If
If oshp.Type = msoPlaceholder Then
If oshp.PlaceholderFormat.ContainedType = msoPicture Then isPic = True
End If
End Function