asked on

Distributing two picture in each slide of a powerpoint

Hi there
I have 5 presentations with a large number of slides which each of slides has to pictures in them (before and after). I want a VBA code to distribute these pictures horizontally. I've found a code for one picture, so it won't work on my presentations.

Sub DHori()
Dim osld As Slide
For Each osld In ActivePresentation.Slides
With osld.Shapes.Range
.Distribute msoDistributeHorrizontally, msoTrue
End With
Next osld
End Sub

I also have another question, all of these pictures are linked in presentation, so each week when opening my presentation they update automatically. is there a code for breaking these links, so I wouldn't have to do this manually?

Rgonzo1971

Hi,

pls try

Sub Macro1()
For Each sld In ActivePresentation.Slides
    For Each shp In sld.Shapes
        If shp.Type = msoLinkedOLEObject Or shp.Type = msoLinkedPicture Then
            On Error Resume Next
            shp.LinkFormat.BreakLink
            On Error GoTo 0
        End If
    Next
Next
End Sub
Sub Macro2()
Dim idx As Integer
Dim strShapes() As String
ReDim strShapes(0 To 0)
For Each sld In ActivePresentation.Slides
    For Each shp In sld.Shapes
        If shp.Type = msoPicture Or shp.Type = msoLinkedOLEObject Or shp.Type = msoLinkedPicture Then
            strShapes(idx) = shp.Name
            idx = idx + 1
            ReDim Preserve strShapes(idx)
        End If
    Next
If idx > 0 Then
    ReDim Preserve strShapes(0 To idx - 1)
    Set oshpR = sld.Shapes.Range(strShapes)
    oshpR.Distribute msoDistributeHorrizontally, msoTrue
End If
Next
End Sub

Open in new window

Regards

John Wilson

Try this:

Sub DHori()
    Dim osld As Slide
    Dim oshp As Shape
    Dim oshpR As ShapeRange
    For Each osld In ActivePresentation.Slides
        For Each oshp In osld.Shapes
   If isPic(oshp) Then
   oshp.Select False
   End If
   Next
     Set oshpR = ActiveWindow.Selection.ShapeRange
       oshpR.Distribute msoDistributeHorizontally, msoTrue
       oshpR.Align msoAlignMiddles, True
        Next osld
End Sub

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

Open in new window

Ashkan Lotfipour

ASKER

Thank you very much for your helpful responses.
Rgonzo code is great for breaking links, but it has a compile error (subscript out of range) in this line:
strShapes(idx) = shp.Name

as for Mr. Wilson's, it has a different error. (Invalid request. to select a shape, its view must be active.) on this line:
oshp.Select False

My office version is 2016 and my pictures have a unique id, Don't know if it matters.

ASKER CERTIFIED SOLUTION

John Wilson

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Ashkan Lotfipour

ASKER

It works like a charm.
Thank you very much for your code. and also Rgonzo1971, for his breaking link code.