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
n = tSN - 1
If iRenameShape Then RenameSelShape iSlide, iSh
'iSh() 배열에 할당된 각각의 개체가 작업 중 삭제되었다면, 오류가 발생됩니다. 따라서, 현재 배열에 할당된 개체가 존재하는지 확인하고, 해당 개체가 있다면 개체의 이름을 tStr() 배열에 추가해줍니다. CheckIsShape 함수도 하단에 있습니다.
If CheckIsShape(iSlide, iSh(i)) Then n = n + 1: ReDim Preserve tStr(tSN To n): tStr(n) = iSh(i).Name
Next
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
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)
Set tSh(n) = iSh(i)
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
For i = LBound(tSh) To UBound(tSh)
tCheck = False
Do
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
Erase tSh
End Function
--------------------------------------
Function CheckIsShape(iSlide As Slide, iSh As Shape) As Boolean
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
댓글 없음:
댓글 쓰기
의견이나 질문이 있으신 분은 언제든지 댓글을 달아주세요~