슬라이드 영역을 벗어난 부분 자동으로 잘라내기

도형과 사진 자동으로 잘라내기

 

위 그림과 같이 슬라이드 영역을 벗어나는 부분을 자동으로 잘라내주는 VBA매크로입니다.

 

사실 잘라내지 않아도 슬라이드 쇼에는 보이지 않기 때문에 문제가 되지 않습니다.

 

하지만 군더더기를 싫어하는 분들은 슬라이드를 벗어나는 도형이나 그림이 눈엣가시일 수도 있습니다.

 

도형의 경우 잘라내려면 슬라이드 외곽에 사각형 도형 등을 임시로 추가하고 원래 도형에서 이 임시 도형을 도형병합(빼기)로 빼내 주어야 합니다. 아래 삼각형처럼 위와 왼쪽이 벗어나는 경우 두 번 작업을 해줘야 합니다.

 

사진의 경우 그림 '자르기' 기능을 이용해서 벗어나는 영역을 Crop해주고 사진 위치와 크기도 알맞게 조절해줘야 합니다.

특히 이 과정은 마우스로 하다보면 정확한 작업이 어렵고 번거로운 작업입니다.

 

 

이런 경우 아래 VBA를 이용하면 도형이나  사진이 슬라이드 영역을 벗어날 경우

도형은 도형병합(빼기)로 잘라내어서 슬라이드 안쪽 부분만 자유형 도형으로 만들어 주고

사진은 그림 잘라내기 기능과 같이 보이는 영역을 조절하고 사진 크기도 조절해 줍니다.

사진의 경우 보이는 영역만 바뀌고 원본 사진을 건드리지 않습니다.

 

도형의 경우 하이퍼링크나 도형순서는 변동이 없고 애니메이션은 사라지는데 애니메이션도 복구해줍니다.

 

Option Explicit

Dim SW!, SH!

Sub CropOutShapesInCurrentSlide()

    Dim osld As Slide
    Dim oshp As Shape
    Set osld = ActiveWindow.View.Slide
    
    If SW = 0 Then getSWSH
    
    For Each oshp In osld.Shapes
        CropCurrent oshp
    Next oshp

End Sub

Sub CropOutSelectedShapes()
    
    Dim shp As Shape
    
    For Each shp In ActiveWindow.Selection.ShapeRange
        CropCurrent shp
    Next shp
    
End Sub

Function CropCurrent(ByVal cshp As Shape)

    '그림의 경우
    If cshp.Type = msoPicture Then
        Call CropOutPicture(cshp)
    '도형의 경우
    ElseIf cshp.Type = msoAutoShape Or cshp.Type = msoFreeform Then
        Call CropOutShape(cshp)
    End If
    
End Function

Function getSWSH()

    With ActivePresentation.PageSetup
        SW = .SlideWidth
        SH = .SlideHeight
    End With
    
End Function

Function CropOutPicture(sPic As Shape)
    Dim x!, y!, w!, h!, l!, t!
    
    '슬라이드 크기
    If SW = 0 Or SH = 0 Then getSWSH
    
    '최초 크기, 위치
    w = sPic.Width
    h = sPic.Height
    l = sPic.Left
    t = sPic.Top
    
    '그림이 슬라이드 내에 있으면 리턴
    If l >= 0 And t >= 0 And l + w <= SW And t + h <= SH Then Exit Function
    
    '비율 유지 안함
    sPic.LockAspectRatio = msoFalse
    
    With sPic.PictureFormat

        If l < 0 Then
            x = sPic.Left
            sPic.ScaleWidth (w + x) / w, msoFalse, msoScaleFromTopLeft
            .Crop.PictureWidth = w
            .Crop.PictureOffsetX = x / 2
            sPic.Left = 0
        End If
        If (l + w) > SW Then
            x = (l + w) - SW
            sPic.ScaleWidth (w - x) / w, msoFalse, msoScaleFromTopLeft
            .Crop.PictureWidth = w
            .Crop.PictureOffsetX = x / 2
        End If
        If t < 0 Then
            y = sPic.Top
            sPic.ScaleHeight (h + y) / h, msoFalse, msoScaleFromTopLeft
            .Crop.PictureHeight = h
            .Crop.PictureOffsetY = y / 2
            sPic.Top = 0
        End If
        If (t + h) > SH Then
            y = (t + h) - SH
            sPic.ScaleHeight (h - y) / h, msoFalse, msoScaleFromTopLeft
            .Crop.PictureHeight = h
            .Crop.PictureOffsetY = y / 2
        End If
        
    End With
    
End Function

Private Sub CropCurrentPicture()
    
    CropOutPicture ActiveWindow.Selection.ShapeRange(1)
    
End Sub

Function CropOutShape(ByVal sShp As Shape)
    
    Dim sld As Slide
    Dim shp As Shape, tShp As Shape
    Dim w!, h!, l!, t!
    
    Set sld = sShp.Parent
    '슬라이드 크기
    If SW = 0 Or SH = 0 Then getSWSH
    
    '최초 크기, 위치
    w = sShp.Width: h = sShp.Height: l = sShp.Left: t = sShp.Top
    
    '그림이 슬라이드 내에 있으면 리턴
    If l >= 0 And t >= 0 And l + w <= SW And t + h <= SH Then Exit Function
 
    If l < 0 Then
        Set tShp = sld.Shapes.AddShape(msoShapeRectangle, l, t, -l, h)
        Set sShp = SubtractAB(sld, sShp, tShp)
    End If
    
    w = sShp.Width: h = sShp.Height: l = sShp.Left: t = sShp.Top
    If (l + w) > SW Then
        Set tShp = sld.Shapes.AddShape(msoShapeRectangle, SW, t, l + w - SW, h)
        Set sShp = SubtractAB(sld, sShp, tShp)
    End If
    
    w = sShp.Width: h = sShp.Height: l = sShp.Left: t = sShp.Top
    If t < 0 Then
        Set tShp = sld.Shapes.AddShape(msoShapeRectangle, l, t, w, -t)
        Set sShp = SubtractAB(sld, sShp, tShp)
    End If
    
    w = sShp.Width: h = sShp.Height: l = sShp.Left: t = sShp.Top
    If (t + h) > SH Then
        Set tShp = sld.Shapes.AddShape(msoShapeRectangle, l, SH, w, t + h - SH)
        Set sShp = SubtractAB(sld, sShp, tShp)
    End If
 
End Function

Function SubtractAB(ByVal s As Slide, ByVal A As Shape, ByVal B As Shape) As Shape
    Dim Z As Long
    Dim N As String
    Dim nShp As Shape
    Dim HasAnim As Boolean
    
    Z = A.ZOrderPosition
    N = A.Name
    HasAnim = CheckAnimations(A)
    If HasAnim Then A.PickupAnimation
    DoEvents
    s.Shapes.Range(Array(A.ZOrderPosition, B.ZOrderPosition)).MergeShapes (msoMergeSubtract)
    DoEvents
    Set nShp = s.Shapes(Z)
    nShp.Name = N
    If HasAnim Then nShp.ApplyAnimation
    DoEvents
    Set SubtractAB = nShp
End Function

Private Sub CropCurrentShape()
    
    CropOutShape ActiveWindow.Selection.ShapeRange(1)
    
End Sub

Function CheckAnimations(aShp As Shape) As Boolean
    Dim aSld As Slide
    Dim eft As Effect
    Dim seq As Sequence
    
    Set aSld = aShp.Parent
    Set eft = aSld.TimeLine.MainSequence.FindFirstAnimationFor(aShp)
    If Not eft Is Nothing Then CheckAnimations = True: Exit Function
    
    For Each seq In aSld.TimeLine.InteractiveSequences
        Set eft = seq.FindFirstAnimationFor(aShp)
        If Not eft Is Nothing Then CheckAnimations = True: Exit Function
    Next seq
    
End Function

'그림 왼쪽 절반 크롭 예시
Private Sub CropLeftHalf()
    Dim oW As Single, cW As Single
    
    With ActiveWindow.Selection.ShapeRange(1)
        oW = .Width '원래 크기
        cW = oW / 2 '잘라낼 크기
        .LockAspectRatio = msoFalse
        .IncrementLeft cW   '오른쪽으로 잘라낸 만큼 이동
        .ScaleWidth cW / oW, msoFalse, msoScaleFromTopLeft '크기를 절반으로 줄임
        .PictureFormat.Crop.PictureWidth = oW   '원래 크기로
        .PictureFormat.Crop.PictureOffsetX = -cW / 2    '절반의 절반만큼 잘라냄
    End With
End Sub

 

VBA로 만드는 과정에서 사진(그림)영역 자르기는 엑셀에서 매크로 녹화 후 그 과정을 참고해서 파워포인트로 옮겼습니다.

 

실행 영상:

 

 

>> 관련 지식인 질문

 

샘플 파일 첨부합니다.

 

CropOut1.pptm

0.23MB

 

 

 

[2024/06/12 추가]

 

 

위의 경우 도형이나 그림이 회전한 경우 예상하지 않은 오류가 발생합니다.

 

두 가지 문제점이 있습니다.

 

1.개체가 회전한 경우 슬라이드를 벗어났는지 판단하기 어렵습니다.

아래와 같은 경우 도형의 좌측 상단 좌표와 넓이 및 높이로 계산할 때 슬라이드 내에 있지만

회전한 상태에서는 슬라이드를 벗어나고 있습니다.

 

좌표회전 알고리즘(첨부파일 Module2에 포함)을 이용해서 좌표값을 알아내서 계산할 수 있지만

도형은 사각형만 있는 것이 아니고 여러개의 노드가 있는 경우 모든 노드를 계산해야 합니다.

 

그래서 여기서는 도형의 중심에서 모서리까지의 거리를 계산해서 이 도형이 회전해서 커질 수 있는 가장 큰 영역의 네모크기를 계산해서 그 좌표가 슬라이드 밖인지 판단하도록 했습니다.  도형의 중심은 쉽게 알 수 있고 도형이 회전했을 때 가장 커질 수 있는 먼거리(d)는 아래 파란색 삼각형의 대각선 길이가 되겠습니다.

도형의 중심에서 d거리를 빼거나 더해서 도형의 위치를 슬라이드영역과 비교해서 처리하였습니다.

 

 

2. 두 번째 문제는 회전한 개체를 도형병합(빼기)하는 문제입니다.

 

회전한 도형인 경우는 회전한 상태에서 다른 임시 네모 도형과 도형병합(빼기)가 가능하므로  문제가 없습니다.

2013이상에서는 그림도 임시 네모도형과 도형병합이 가능합니다.

그런데 2010이하에서는 이 기능이 지원되지 않으므로 문제가 발생합니다.

 

이 경우에는 회전한 그림을 복사해서 Ctrl+Alt+V로 EMF나 SVG로 붙여넣은 후에 도형병합처리하여야겠습니다.

그림을 복사해서 붙여넣는 작업은 매크로를 실행해도 됩니다.

 

CropOut2.pptm

3.08MB