Grouping of shapes in PowerPoint VBA

[Paul_Hossler]

Hello Paul, I am including something like:

If S1.bottom falls anywhere between (S2.Top and S2.Top + 0.5). Because the shapes seems like touching but they are little away but close enough (creating an illusion). is there any effective way to check for this, can using of multiple operators cause problem?

I used .5 as a tolerance from your PM, but you might have to adjust it to establish your own 'close enough'

What is shape1.top + shape1.height?

what is shape2.top?

What is the difference?

Attach a sample PP if you want


Edit

ver 3 has close shapes and a msgbox macro to show measurements

ver 4 has different tolerances to define close (i.e 2 instead of .5)

I don't see the behavior in your #19, so attach an example and I'll look

[CuriosityBug]

I used .5 as a tolerance from your PM, but you might have to adjust it to establish your own 'close enough'

What is shape1.top + shape1.height?

what is shape2.top?

What is the difference?

Attach a sample PP if you want


Edit

ver 3 has close shapes and a msgbox macro to show measurements

ver 4 has different tolerances to define close (i.e 2 instead of .5)

I don't see the behavior in your #19, so attach an example and I'll look

Attaching the sample Paul. Thank you.

[Paul_Hossler]

I had to change my definition of 'close' to determine if 2 shapes overlapped. I assumed that each shape was +2 up, left, down and right and then checked against these slightly larger shapes

Seem to work better in your case

Tolerance =2 but you can change that

[CuriosityBug]

Ingenious Paul!! I thought this is Impossible but you people made it easier to solve. Thanks a lot. This is new and I will learn it. I am just curious what is 'test' for in pp you attached?

I had to change my definition of 'close' to determine if 2 shapes overlapped. I assumed that each shape was +2 up, left, down and right and then checked against these slightly larger shapes

Seem to work better in your case

Tolerance =2 but you can change that

[Paul_Hossler]

'Test' is a throw-away macro I wrote when I was investigating why some shapes would group when I didn't expect them to

You can delete the entire standard module

Option Explicit


Sub test()
    Dim s As String
    Dim S1 As Dimensions, S2 As Dimensions


    With ActivePresentation.Slides(1)
        S1 = GetDimensions(.Shapes("myShape1"))
        S2 = GetDimensions(.Shapes("myShape2"))
        
        s = "S1 Top = " & S1.Top & vbCrLf & "s1.Height = " & S1.Height & vbCrLf & "S2 Top = " & S2.Top & vbCrLf
        s = s & "Gap = " & (S1.Top + S1.Height - S2.Top)


        MsgBox s
    End With


End Sub

[CuriosityBug]

Perfect! Thank you.

'Test' is a throw-away macro I wrote when I was investigating why some shapes would group when I didn't expect them to

You can delete the entire standard module

Option Explicit


Sub test()
    Dim s As String
    Dim S1 As Dimensions, S2 As Dimensions


    With ActivePresentation.Slides(1)
        S1 = GetDimensions(.Shapes("myShape1"))
        S2 = GetDimensions(.Shapes("myShape2"))
        
        s = "S1 Top = " & S1.Top & vbCrLf & "s1.Height = " & S1.Height & vbCrLf & "S2 Top = " & S2.Top & vbCrLf
        s = s & "Gap = " & (S1.Top + S1.Height - S2.Top)


        MsgBox s
    End With


End Sub

[Paul_Hossler]

Here's a more cleaned up 'production' ready version

This was a fun little project

[CuriosityBug]

Sure! Thank Paul. you are a Gem!! A light in dark tunnel.

Here's a more cleaned up 'production' ready version

This was a fun little project

[CuriosityBug]

Thanks John and other contributors for helping people for no reason. Thanks VBA express team!