텍스트상자와 배경도형 정렬

파워포인트 작업을 하다가 보면

단순 반복작업이 많습니다.

 

똑같은 작동을 하도록 같은 작업을 수십번 하는 것이 지겨울 수 있습니다.

그럴 때는 VBA매크로를 이용해보세요.

(물론 처음엔 VBA를 작성하는 것이 수작업보다 시간이 더 걸릴 수는 있습니다.)

 

이번 경우는 배경도형위에 텍스트 상자가 있을 때 배경도형 중앙에 텍스트 상자가 오도록 하는 작업입니다.

지식인 링크(PPT 텍스트 상자 및 도형과 텍스트상자 정렬하기)

 

 

아래와 같은 코드로 현재 선택된 텍스트박스와 도형을 정렬시킬 수 있습니다.

두 도형을 위치와 크기를 동일하게 맞추고 가운데 정렬합니다.

​

Alt-F11누르고 삽입-모듈 추가하고 코드를 붙여넣고 코드창 닫은 다음

일반편집화면에서 텍스트박스와 도형을 동시에 선택하고 Alt-F8로 AlignCurrentTwoShapes 매크로 실행합니다.

 

Option Explicit
Sub AlignCurrentTwoShapes()
    
    Dim shp1 As Shape, shp2 As Shape
    Dim shpT As Shape, shpB As Shape

    
    On Error Resume Next
    If ActiveWindow.Selection.ShapeRange.Count <> 2 Then MsgBox "도형을 2개 선택하세요": Exit Sub
    Set shp1 = ActiveWindow.Selection.ShapeRange(1)
    Set shp2 = ActiveWindow.Selection.ShapeRange(2)
    
    If shp1.Type = msoTextBox Then
        Set shpT = shp1
        Set shpB = shp2
    ElseIf shp2.Type = msoTextBox Then
        Set shpT = shp2
        Set shpB = shp1
    Else
        MsgBox "텍스트 박스와 일반 도형을 선택해야합니다.": Exit Sub
    End If
    
    Call AlignTextShape(shpT, shpB)

End Sub
    
Function AlignTextShape(shpText As Shape, shpBack As Shape)

    shpBack.ZOrder msoSendBehindText
    shpText.Width = shpBack.Width       '넓이 동일하게
    shpText.Height = shpBack.Height     '높이 동일하게
    shpText.Left = shpBack.Left         '좌표 동일하게
    shpText.Top = shpBack.Top
    shpText.TextFrame.VerticalAnchor = msoAnchorMiddle  '세로 가운데로
    shpText.TextFrame2.WordWrap = msoFalse              '줄바뀜 없이
    shpText.TextFrame.TextRange.ParagraphFormat.Alignment = ppAlignCenter   '가로 가운데로

End Function

 

좀더 나아가서 현재 선택된 모든 (텍스트박스) 도형에 대해 위와 같은 처리를 할 수도 있습니다.

텍스트박스에 대해 겹치는 도형을 찾아서 서로 일치시키고 가운데 정렬합니다.

슬라이드에서 텍스트박스를 포함하여 원하는 도형들을 선택하고 Alt-F8로 AlignSelectedShapes를 실행합니다.

 

Sub AlignSlectedShapes()
    
    Dim shp As Shape
    Dim shpT As Shape, shpB As Shape
    
    On Error Resume Next
    If ActiveWindow.Selection.ShapeRange.Count < 1 Then MsgBox "도형을 선택하세요": Exit Sub
    
    For Each shp In ActiveWindow.Selection.ShapeRange
            
        If shp.Type = msoTextBox Then
            Set shpT = shp
            'Set shpB = Nothing
            Set shpB = FindBackShape(shp)
            If Not shpB Is Nothing Then
                Call AlignTextShape(shpT, shpB)
            End If
            
        End If
        
    Next shp
End Sub

' 겹치는 도형 찾기
Function FindBackShape(oShp As Shape) As Shape
    
    Dim shp As Shape
    Dim sld As Slide
    
    Set sld = oShp.Parent
    For Each shp In sld.Shapes
        If shp.Type <> msoTextBox And Not shp Is oShp Then
            
            If AABB(shp, oShp) Then Set FindBackShape = shp: Exit For
            
        End If
    Next shp

End Function

'AABB 충돌 체크
Function AABB(A As Shape, B As Shape) As Boolean
     
     If B.Left <= A.Left + A.Width And A.Left <= B.Left + B.Width _
        And A.Top <= B.Top + B.Height And B.Top <= A.Top + A.Height Then AABB = True

End Function

위 두 매크로 실행화면입니다.

 

 

 

더 빨리 위 기능을 호출하려면 빠른 실행에 위 두 매크로를 추가하면

(빠른실행도구모음사용자지정 - 매크로 - 매크로함수 우측으로 보내기)

텍스트상자 도형들을 선택한 다음 Alt-4 나 Alt-5 키 등 Alt-숫자키로 바로 실행할 수도 있습니다.

아래 영상 참고하세요.

 

 

 

첨부파일 참고하세요.

파일 속성에서 차단해제 적용권장하고 반드시 매크로 허용해서 열어서 테스트해보세요.

AlignTextBox1.pptm

0.05MB