Results 1 to 2 of 2

Thread: Dynamic Image Adjustment

  1. #1
    VBAX Newbie
    May 2021

    Exclamation Dynamic Image Adjustment

    Hello everyone, how are you?
    I hope everything goes good.

    A couple of weeks ago, i open a thread with a problem: adjust the same size to all the images in an active presentation withouth textboxes.
    The code worked, but now i have other problem. The images that i paste in each slide, has different dimensions what makes difficult the correct visualization of the slide. Now, i would to know if it's possible adjust all the images in the active slide dynamiclly.

    For example, i have 4 images in the active slide. These images have the same high size and cannot exceed 13 centimeters high. I want them to be distributed horizontally with a small space between them and without leaving the slide. If the sum of the widths is higher that the slide width, reduce all images. Like this:


    The same situation when i paste 3,2 or 1 images. Ever the max images per slide will be 4.

    I hope i have explained well.
    It would be great if you can help me.


  2. #2
    VBAX Master
    Feb 2007
    You could start with this and play with it!

    Sub fixPic()
    Dim rayPic() As Shape
    Dim osld As Slide
    Dim opic As Shape
    Dim L As Long
    ReDim rayPic(1 To 1)
    Set osld = ActiveWindow.Selection.SlideRange(1)
    For Each opic In osld.Shapes
    If isPIC(opic) Then
    opic.Height = 100
    Set rayPic(UBound(rayPic)) = opic
    ReDim Preserve rayPic(1 To UBound(rayPic) + 1)
    End If
    Next opic
    rayPic(1).Left = 10
    rayPic(1).Top = 100
    For L = 2 To UBound(rayPic) - 1
    rayPic(L).Left = rayPic(L - 1).Width + rayPic(L - 1).Left + 10
    rayPic(L).Top = 100
    rayPic(L).Select False
    Next L
    With ActiveWindow.Selection.ShapeRange.Group
    .LockAspectRatio = True
    .Width = ActivePresentation.PageSetup.SlideWidth - 20
    .Left = 10
    End With
    End Sub
    Function isPIC(opic As Shape) As Boolean
    If opic.Type = msoPicture Then isPIC = True
    If opic.Type = msoPlaceholder Then
    If opic.PlaceholderFormat.ContainedType = msoPicture Then isPIC = True
    End If
    End Function
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts