Consulting

Results 1 to 2 of 2

Thread: I can't get the logic to conditionally align these 2 shapes

  1. #1
    VBAX Regular
    Joined
    Mar 2019
    Posts
    73
    Location

    I can't get the logic to conditionally align these 2 shapes

    In the finished presentation, each slide will have a rectangle object and a picture object.
    In some of the slides, the rectangle will be vertically aligned to the slide.
    In some of the slides, the rectangle will be horizontally aligned to the slide.
    In the case where it is horizontally aligned, my existing code is horizontally centering the rectangle on the slide.
    I would like logic that tells the picture object that is also on that slide to center itself on the slide.

    This is the code that I have so far. I know I have the If statements tangled up, which is likely causing my problem. I've attached a trimmed-down version of the final product. Can anyone help me sort this out?

    Sub Center_Horizontal_Rectangle()
    
    
    Dim osld As Slide
    Dim oshp As Shape
    Dim x As Integer
    Dim y As Integer
    
    
    With ActivePresentation.PageSetup
    x = .SlideWidth / 2
    y = .SlideHeight / 2
    End With
    
    
    For Each osld In ActivePresentation.Slides
    For Each oshp In osld.Shapes
    
    
        If oshp.Type = msoShapeRectangle And oshp.Height < 2 * 72 Then ' Use for shapes
    
    
           oshp.Left = x - (oshp.Width / 2)          ' Center from left to right
            
                 If oshp.Type = msoPicture Then
                     oshp.Left = x - (oshp.Width / 2)
                 End If
        
        End If
    
    Next
    
    Next
    
    End Sub
    Attached Files Attached Files

  2. #2
    VBAX Master
    Joined
    Feb 2007
    Posts
    2,093
    Location
    Maybe this (note you would have to remove the instruction rectangles)

    Sub Center_Horizontal_Rectangle()
    Dim osld   As Slide
    Dim oshp   As Shape
    Dim x      As Long
    Dim y      As Long
    With ActivePresentation.PageSetup
    x = .SlideWidth / 2
    y = .SlideHeight / 2
    End With
    For Each osld In ActivePresentation.Slides
    If hasHorRect(osld) Then
    For Each oshp In osld.Shapes
    If oshp.Type = msoShapeRectangle Or oshp.Type = msoPicture Then
    oshp.Left = x - oshp.Width / 2
    End If
    Next
    End If
    Next osld
    End Sub
    
    
    Function hasHorRect(osld As Slide) As Boolean
    Dim oshp As Shape
    For Each oshp In osld.Shapes
    If oshp.Type = msoShapeRectangle Then
    If oshp.Width > oshp.Height Then
    hasHorRect = True
    End If
    End If
    Next oshp
    End Function
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html

Posting Permissions

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