Macro to Resize/Position Pictures, Update Links & send to back, and save as PDF
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
Code:
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:
Code:
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