PowerPoint 매크로 - 그림, 도형 정렬/배열하기 (5) - 위치별 그림 배열하기

 사용자가 선택한 순서와 상관없이 현재의 그림 배열에 따라 격자 배열을 하도록 만든 Sub 프로시저입니다. 대부분은 선택순 배열 방법과 유사하며, 차이가 나는 부분은 빨간색으로 표기해두었습니다.

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

Sub AlignShapes_Position()
  'On Error GoTo ErrorHandler
  Dim tSlide As Slide, tSR As ShapeRange, tSh() As Shape
  Dim i As Long, j As Long, k As Long, n As Long
  Dim tStr As String, tNW As Long, tNH As Long, tLeft As Single, tTop As Single
  Dim tCellW As Single, tCellH As Single, tShW As Single, tShH As Single, tMW As Single, tMH As Single
  Dim tX(), tY(), tXO(), tYO(), tXG(), tYG()
  
  Set tSlide = ActiveSlide
  If Not Check_ShapeExist(tSlide, AlignBox) Then
    MsgBox "그림 배열을 위한 도구상자가 없습니다. 생성된 도구상자를 이용하여 그림을 배열할 위치를 지정하세요.", vbInformation, "작업 오류"
    ControlAlignBox True
    Exit Sub
  End If

  Set tSR = SelectedShapeRange(True)
  n = 0
  For i = 1 To tSR.Count
    If tSR(i).Name <> AlignBox.Name And tSR(i).Id <> AlignBox.Id Then
      n = n + 1
      ReDim Preserve tSh(1 To n)
      Set tSh(n) = tSR(i)
    End If
  Next
  If n = 0 Then Exit Sub
  
  tNW = -Int(-Sqr(n))
  tStr = InputBox("가로로 배열할 갯수를 입력하세요.", "가로 배열", tNW)
  tNW = Val(tStr)
  If tNW <= 0 Then Exit Sub
  
  tNH = -Int(-n / tNW)
  tStr = InputBox("세로로 배열할 갯수를 입력하세요.", "세로 배열", tNH)
  tNH = Val(tStr)
  If tNH < 0 Then Exit Sub
  
  tStr = InputBox("가로 방향 그림 간격을 입력하세요. (% 단위)", "가로 간격", 0)
  If StrPtr(tStr) = 0 Then Exit Sub
  tMW = Val(tStr)
  
  tStr = InputBox("세로 방향 그림 간격을 입력하세요. (% 단위)", "세로 간격", 0)
  If StrPtr(tStr) = 0 Then Exit Sub
  tMH = Val(tStr)
  
  With AlignBox
    tLeft = .Left
    tTop = .Top
    tCellW = .Width / tNW
    tCellH = .Height / tNH
    tMW = tCellW * tMW / 100
    tMH = tCellH * tMH / 100
    tShW = tCellW - tMW * 2
    tShH = tCellH - tMH * 2
  End With

  
  ReDim tX(1 To UBound(tSh))
  ReDim tY(1 To UBound(tSh))
  '도형의 중간 위치 좌표를 X, Y 좌표로 읽어옵니다.
  For i = 1 To UBound(tSh)
    tX(i) = tSh(i).Left + tSh(i).Width / 2
    tY(i) = tSh(i).Top + tSh(i).Height / 2
  Next

  'X, Y 좌표로부터 위치 순서를 결정합니다.
  tXO = GetRank(tX, True)
  tYO = GetRank(tY, True)
  '위치 순서로부터 행, 열 좌표로 다시 변환해줍니다.

  tYG = RankToGroup(tYO, tNW)
  tXG = RankToSubGroup(tXO, tYG, tNH)
  
  j = -1: k = -1
  For i = 1 To n
    j = (j + 1) Mod tNW
    If j = 0 Then k = (k + 1) Mod tNH
    With tSh(i)
      .LockAspectRatio = msoFalse
      .Width = tShW
      .Height = tShH
  '그림의 행, 열 좌표에 맞게 격자형태로 배열해줍니다.

      .Left = tLeft + (tXG(i) - 1) * tCellW + tMW
      .Top = tTop + (tYG(i) - 1) * tCellH + tMH
    End With
  Next
ErrorHandler:
  Erase tSh, tX, tY, tXO, tYO, tXG, tYG
End Sub