Как узнать, перекрываются ли два текстовых поля или фигуры с помощью VBA в PowerPoint 2007?

Question

Можно ли как-нибудь выяснить, перекрываются ли два текстовых поля или фигуры с помощью VBA в PowerPoint (2007)?

Спасибо

Answer 1

Это должно помочь вам.

Необходимо учитывать граничные случаи:

Две фигуры, которые просто касаются друг друга, считаются перекрытием или нет?

А как насчет толщины линий? Размер фигуры не включает толщину линии, но толстая линия может вызвать визуальное перекрытие фигур.

Function ShapesOverlap(oSh1 As Shape, oSh2 As Shape) As Boolean
    Dim Shp1Left As Single
    Dim Shp1Right As Single
    Dim Shp1Top As Single
    Dim Shp1Bottom As Single

    Dim Shp2Left As Single
    Dim Shp2Right As Single
    Dim Shp2Top As Single
    Dim Shp2Bottom As Single

    Dim bHorizontalOverlap As Boolean
    Dim bVerticalOverlap As Boolean

    With oSh1
        Shp1Left = .Left
        Shp1Right = .Left + .Width
        Shp1Top = .Top
        Shp1Bottom = .Top + .Height
    End With

    With oSh2
        Shp2Left = .Left
        Shp2Right = .Left + .Width
        Shp2Top = .Top
        Shp2Bottom = .Top + .Height
    End With

    ' do they overlap horizontally?
    If Shp1Left > Shp2Left Then
        If Shp1Left < Shp2Right Then
            bHorizontalOverlap = True
        End If
    End If
    If Shp1Left < Shp2Left Then
        If Shp1Right > Shp2Left Then
            bHorizontalOverlap = True
        End If
    End If

    ' do they overlap vertically?
    If Shp1Top > Shp2Top Then
        If Shp1Top < Shp2Bottom Then
            bVerticalOverlap = True
        End If
    End If
    ' do they overlap vertically?
    If Shp1Top < Shp2Top Then
        If Shp1Bottom > Shp2Top Then
            bVerticalOverlap = True
        End If
    End If

    ShapesOverlap = bHorizontalOverlap And bVerticalOverlap

End Function

Answer 2

Если в вопросе, который я пропускаю, нет глубокого значения, ответ - да.Вы не знаете, как получить доступ к размерам фигур, или знаете, как использовать размеры, чтобы определить, перекрываются ли фигуры?

Следующий макрос выводит размеры каждой фигуры на каждом слайдев ближайшее окно.С помощью этой информации не составит труда проверить наличие совпадений.

Option Explicit
Sub DsplDimensions()

  Dim InxSlide As Long
  Dim InxShape As Long

  With ActivePresentation
    For InxSlide = 1 To .Slides.Count
      Debug.Print "Slide " & InxSlide
      With .Slides(InxSlide)
        For InxShape = 1 To .Shapes.Count
          With .Shapes(InxShape)
            Debug.Print " Shape " & InxShape
            Debug.Print "  Top & left " & .Top & " " & .Left
            Debug.Print "  Height & width " & .Height & " " & .Width
          End With
        Next
      End With
    Next
  End With