글목록

2022년 2월 6일

PowerPoint 매크로 - Shape 배열을 ShapeRange로 변환하기

PowerPoint에서 Shape과 관련된 작업을 하다보면 여러 개의 Shape을 배열에 할당한 후, 배열이나 크기 변경, 삭제 또는 추가.. 등의 작업을 하고, 작업이 완료된 결과물을 다시 선택하거나 그룹화하여 매크로를 종료하게되면, 그 다음 작업을 위해 개체를 재선택하는 번거로움을 많이 줄일 수 있습니다.

예를 들어, tSh()이라는 배열에, 10개의 shape을 할당하고, 이들을 조합하여 2개의 shape을 새로 생성한 후, 총 12개의 shape을 선택한 상태에서 매크로를 종료하고 싶다면, tSh()에는 배열을 변경하여 12개의 shape을 할당할 수 있지만, 배열에 할당된 shape을 선택한 상태로 매크로를 종료할 수 없습니다. 이러한 경우, tSh() 배열에 할당된 전체 개체들을 ShapeRange에 할당해주고, ShapeRange.Select를 추가해주면 됩니다.

그러나, ShapeRange는 배열과 달리 마음대로 크기를 바꾸거나, 아이템의 순서를 변경하는 것이 쉽지 않으며, 심지어는 여러 개의 개체를 ShapeRange에 할당하는 것도 생각보다 쉽지 않습니다.

아래에는 매크로 작업을 위해 여러 개의 Shape이 포함된 배열을 ShapeRange로 변환하는 함수입니다. 사실 일반적인 경우에는 1번째 함수만으로도 큰 무리없이 변환이 됩니다만, 선택된 개체 중 일부가 작업 중 삭제되었거나, 개체명이 중복되었을 때 오류가 발생하는 경우가 있어서, 함수를 여러 개로 나눠 두었습니다. 본인이 사용하는 환경에 맞게 적절하게 수정해서 사용하시면 될 것 같습니다.

--------------------------------------
Function GetShapeRange(iSlide As Slide, iSh() As Shape, Optional iRenameShape As Boolean = True) As ShapeRange
  On Error GoTo ErrorHandler
  Dim tStr() As String, i As Long, n As Long, tSN As Long
  tSN = LBound(iSh)
  n = tSN - 1
  '대체로 1개 슬라이드에 포함된 Shape은 서로 다른 이름으로 자동할당되기 때문에 이름이 다른 경우, 개체도 달라집니다. 그러나, 간혹 그룹화, 그룹해제, 복사, 삭제 등.. 복합적인 작업 과정에서 개체명이 같은 경우가 있습니다. 특히 개체수가 많을수록 이러한 문제가 발생되기도 합니다. 중복된 개체명이 있다면 개체명을 다르게 지정해주도록 하려면 모든 개체의 이름을 확인하고 비교해야하기 때문에 약간 느려질 수 있습니다. iRenameShape의 디폴트 값을 false로 하면, 개체명 확인 및 변경 작업을 생략할 수 있기 때문에 사용자 작업 환경에 맞게 조정하시면 됩니다. RenameSelShape 함수는 하단에 있습니다.
  If iRenameShape Then RenameSelShape iSlide, iSh
  'iSh() 배열에 할당된 각각의 개체가 작업 중 삭제되었다면, 오류가 발생됩니다. 따라서, 현재 배열에 할당된 개체가 존재하는지 확인하고, 해당 개체가 있다면 개체의 이름을 tStr() 배열에 추가해줍니다. CheckIsShape 함수도 하단에 있습니다.
  For i = LBound(iSh) To UBound(iSh)
    If CheckIsShape(iSlide, iSh(i)) Then n = n + 1: ReDim Preserve tStr(tSN To n): tStr(n) = iSh(i).Name
  Next
  '만약 iSh() 배열의 개체가 1개 이상 있다면, tStr()에 할당된 개체명 배열을 아래와 같이 Shapes.Range() 메서드를 이용하여 ShapeRange로 지정한 후 반환해줍니다.
  If n >= tSN Then Set GetShapeRange = iSlide.Shapes.Range(tStr)
ErrorHandler:
  Erase tStr
End Function
--------------------------------------
Function RenameSelShape(iSlide As Slide, iSh() As Shape)
  On Error GoTo ErrorHandler
  '이 함수는 현재 작업하고 있는 슬라이드에서 iSh()에 할당된 개체들의 이름과 ID를 비교하여 이름이 중복된 개체가 존재할 때 개체명을 변경해주는 함수입니다. 모든 개체의 개체명을 다르게 만들면, 개체명만으로도 원하는 개체를 선택할 수 있습니다.
  Dim tSh() As Shape, i As Long, j As Long, n As Long, tStr As String, tCheck As Boolean
  n = 0
  For i = LBound(iSh) To UBound(iSh)
    n = n + 1
    ReDim Preserve tSh(1 To n)
  '입력받은 iSh()의 각각의 개체를 tSh()에 지정해줍니다.
    Set tSh(n) = iSh(i)
  '만약, iSh()의 어떤 개체가 그룹화된 개체라면, 그룹 내 각 개체로 나눠서 tSh() 배열에 할당해줍니다.
    If iSh(i).Type = msoGroup Then
      For j = 1 To iSh(i).GroupItems.Count
        n = n + 1
        ReDim Preserve tSh(1 To n)
        Set tSh(n) = iSh(i).GroupItems(j)
      Next
    End If
  Next
  'tSh()에 지정된 개체의 이름과 ID를 비교하여 고유의 이름인지 확인하고, 이름이 중복되었다면 이름을 바꿔줍니다.
  For i = LBound(tSh) To UBound(tSh)
    tCheck = False
    Do
  '만약, 특정 개체의 ID와 해당 이름으로 다시 검색된 개체의 ID가 동일하다면, 이름으로 검색된 개체는 그냥 놔둡니다. 만약 이름이 중복되었다면 ID가 다르게 나타나게 되므로, 이름을 변경해줍니다. GetRandomString을 사용하여 10자짜리 무작위 이름을 만들어주어도 되고, 해당 개체의 이름에 다른 문자를 추가해주어도 됩니다.
  '모든 개체의 이름을 비교하게 되면 n개의 개체가 있을 때, n x (n-1)번 이름을 비교하게 되지만, 아래와 같이 지정하게 되면, n번만 이름을 확인하게 되므로 계산 횟수가 줄어들게 됩니다.
      If tSh(i).Id = iSlide.Shapes(tSh(i).Name).Id Then
        tCheck = True: Exit Do
      Else
        If tSh(i).Type = msoGroup Then tStr = "gr_" Else tStr = "sh_"
        tSh(i).Name = tStr & GetRandomString(10)
      End If
    Loop Until tCheck
  Next
ErrorHandler:
  'tSh()의 개체에 대한 이름을 변경하더라도 iSh()의 개체도 동일하게 변경되므로 별도로 결과를 반환할 필요는 없습니다.
  Erase tSh
End Function
--------------------------------------
Function CheckIsShape(iSlide As Slide, iSh As Shape) As Boolean
  '입력된 개체가 작업 중 삭제되었거나 변경되었을 수 있기 때문에, 개체가 해당 슬라이드에 존재하는지 확인하는 함수입니다. 해당 개체의 이름이나 ID를 확인하라고 했을 때, 개체가 삭제되었다면 오류가 발생합니다. 따라서, 오류가 없다면 해당 개체가 존재한다는 의미이고, 오류가 발생한다면 해당 개체가 삭제되었음을 의미하므로 개체의 존재 여부를 확인할 수 있습니다.
  On Error GoTo ErrorHandler
  Dim tStr As String, tID
  tStr = iSlide.Shapes(iSh.Name).Name
  tID = iSlide.Shapes(iSh.Name).Id
  CheckIsShape = True
  Exit Function
ErrorHandler:
  CheckIsShape = False
End Function

댓글 없음:

댓글 쓰기

의견이나 질문이 있으신 분은 언제든지 댓글을 달아주세요~

많이 본 글 :