PowerPoint 매크로 - 잘라낸(Crop) 사진 변경 : 자르기 영역을 유지하면서 위치, 크기만 조정하기

Powerpoint에서 자르기(Crop)를 통해 잘라낸 사진은 별도로 '그림 압축'을 하지 않았다면, 원본 사진의 정보를 그대로 남게 됩니다. 따라서, 그림 자르기를 다시 실행하면 잘라낼 위치를 변경할 수 있습니다.

지난번 글에서 일괄 자르기로 사진을 잘라내다보면, 사진마다 원하는 영역을 잘라내지 못하고 약간씩 어긋날 수 있습니다. 고정된 삼각대를 이용하여 고정된 위치를 찍은 사진이라면 상관없지만, 손으로 찍은 사진들은 크기도 약간씩 다르고, 위치도 약간씩 어긋나게 찍히다보니 매크로를 이용하여 일괄 자르기를 하더라도 다시 수작업으로 번거롭게 위치를 조정해야하는 일이 발생합니다.

위의 상황과 같이, 잘라낸 영역이 한쪽으로 치우쳐있는 경우, 잘라낼 영역을 그대로 두고, 원본사진을 약간씩 이동하거나, 원본 사진을 그대로 두고 잘라낼 위치를 이동하게 되면, 잘라내는 영역의 크기는 그대로 두고 잘라낼 위치만 조정할 수 있습니다.

혹은 위와 같이 잘라내려는 영역보다 피사체가 크거나 작은 경우에는 잘라낼 영역은 그대로 두고, 원본 사진을 확대, 축소하게 되면 다른 사진과 어울리는 배율로 조정할 수도 있습니다.

이러한 기능을 구현하기 위해 아래와 같이 잘라낸 사진을 이동하거나 확대/축소하는 함수를 만들어두고, 사용자 정의 폼이나 버튼을 만들어 선택된 사진들을 일괄적으로 조정할 수 있도록 해주면, Powerpoint에 여러 개의 사진을 한꺼번에 넣고 일괄적으로 잘라낸 후 원하는 위치로 세부 조정까지 가능한 기능을 구현할 수 있습니다. 작업이 완료된 사진은 압축하기로 불필요한 부분을 삭제하여 파일 용량을 줄여줄 수 있습니다.

'---------------------------------------------
Function Crop_MoveSelPictures(iMoveDirection As String, Optional iRatio As Single = 5)
  '파워포인트 슬라이드에서 사진을 선택한 후, crop 위치를 옮기는 함수입니다. 여러 사진을 선택해서 작업하는 중 사진이 아닌 일반 도형이 선택되거나, 동영상 등 잘라내기 작업이 되지 않는 개체를 실수로 선택했을 때, 오류 없이 다음 작업을 진행하도록 선언해둡니다.

  '이동시킬 방향(iMoveDirection), 한번 실행할 때마다 이동량을 비율(iRatio)로 입력받습니다. 기본값은 사진 크기의 5%로 입력받지만, 사용자가 이동량을 결정할 수 있도록 합니다. 이동량은 비율로 받을 수도 있고, Point나 길이로 입력받을 수도 있습니다. 개인의 사용환경에 따라 수정하시면 됩니다.

  On Error Resume Next
  Dim i As Long, tSel As ShapeRange, tRatio as Single

  '슬라이드에서 선택된 사진들을 ShapeRange로 지정해둡니다.
  Set tSel = SelectedShapeRange
  tRatio = iRatio

  if tRatio >= 100 then tRatio = 5

  For i = 1 To tSel.Count

  '각각의 사진에 대하여, 잘라내기 속성(Crop)을 조정해줍니다. L, R, U, D를 문자로 입력받으면, 해당 방향으로 잘라낼 위치를 이동해줍니다. 만약 이동하려는 방향으로 사진의 가장자리를 넘어가게 되면, 이동을 멈추고 Crop의 끝과 사진의 끝을 맞춰줍니다.
    With tSel(i).PictureFormat.Crop
      Select Case UCase(iMoveDirection)
        Case "L"
          If .PictureOffsetX - .PictureWidth * tRatio / 100 >= (.ShapeWidth - .PictureWidth) / 2 Then
            .PictureOffsetX = .PictureOffsetX - .PictureWidth * tRatio / 100
          Else
            .PictureOffsetX = (.ShapeWidth - .PictureWidth) / 2
          End If
        Case "R"
          If .PictureOffsetX + .PictureWidth * tRatio / 100 <= (.PictureWidth - .ShapeWidth) / 2 Then
            .PictureOffsetX = .PictureOffsetX + .PictureWidth * tRatio  / 100
          Else
            .PictureOffsetX = (.PictureWidth - .ShapeWidth) / 2
          End If
        Case "U"
          If .PictureOffsetY - .PictureHeight * tRatio / 100 >= (.ShapeHeight - .PictureHeight) / 2 Then
            .PictureOffsetY = .PictureOffsetY - .PictureHeight * tRatio / 100
          Else
            .PictureOffsetY = (.ShapeHeight - .PictureHeight) / 2
          End If
        Case "D"
          If .PictureOffsetY + .PictureHeight * tRatio / 100 <= (.PictureHeight - .ShapeHeight) / 2 Then
            .PictureOffsetY = .PictureOffsetY + .PictureHeight * tRatio / 100
          Else
            .PictureOffsetY = (.PictureHeight - .ShapeHeight) / 2
          End If
      End Select
    End With
  Next
End Function

'---------------------------------------------

Function Crop_EnlargeSelPictures(iEnlarge As Boolean, iWidth As Boolean, iHeight As Boolean, Optional iRatio As Single = 5)

  '잘라낼 영역을 그대로 두고, 사진의 크기를 변경하여 확대, 축소합니다. 사진을 확대할지, 축소할지, 폭방향으로 조정할지, 높이방향으로 조정할지 입력받습니다. 폭과 높이를 동시에 확대할 때에는 iWidth=True, iHeight=True로 입력받으면 되고 그림 전체가 확대/축소됩니다.

  On Error Resume Next
  Dim i As Long, tSel As ShapeRange, tRatio as Single
  Set tSel = SelectedShapeRange
  tRatio = iRatio

  if tRatio >= 100 then tRatio = 5

  For i = 1 To tSel.Count
    With tSel(i).PictureFormat.Crop
      If iEnlarge Then
        If iWidth Then .PictureWidth = .PictureWidth * (1 + tRatio / 100)
        If iHeight Then .PictureHeight = .PictureHeight * (1 + tRatio / 100)
      Else
        If iWidth Then .PictureWidth = .PictureWidth * (1 - tRatio / 100)
        If iHeight Then .PictureHeight = .PictureHeight * (1 - tRatio / 100)
      End If
    End With
  Next
End Function