텍스트 상자를 단어 단위로 분리하기

'철수와 영희가 같이 있다'에서 '철수'만 애니메이션을 적용하려면

해당 부분만 따로 텍스트 상자를 만들어야 합니다.

​

그런데 따로 텍스트상자로 복사해서 위치를 맞추고 편집하는 것이 매우 귀찮은 작업입니다.

​

이런 경우 아래 VBA를 이용하면 빈칸을 기준으로 텍스트를 분리해서

자동으로 단어마다 텍스트 상자를 만들어줄 수 있습니다.

​

​

alt+F11 창에서 삽입 > 모듈 추가한 후에 아래 코드를 붙여넣습니다.

그리고 코드 창을 닫고 원하는 텍스트 상자나 도형을 선택한 상태에서 Alt+F8을 누르고 매크로를 실행하면 되됩니다.

Option Explicit

'Const SplitChar = "/"
Const SplitChar = " "

Sub SplitCurrentTextframe()

    Dim shp As Shape, shpT As Shape, tr As TextRange
    Dim l As Integer, m As Integer
    
    On Error Resume Next
    Set shp = ActiveWindow.Selection.ShapeRange(1)
    If shp Is Nothing Then MsgBox "'" & SplitChar & "'로 분리된 텍스트박스를 먼저 선택하세요.": Exit Sub
    On Error GoTo 0
    
    For l = 1 To shp.TextFrame.TextRange.Lines.Count
        
        Set shpT = shp.Duplicate(1)
        shpT.Left = shp.Left: shpT.Top = shp.Top
        '다른 행 삭제
        With shpT.TextFrame.TextRange
            For m = .Lines.Count To 1 Step -1
                If m <> l Then .Lines(m).Delete
            Next m
            '마지막 엔터 삭제
            If Asc(.Characters(.Length)) = 13 Then .Characters(.Length).Delete
        End With
        '높이 조절
        With shp.TextFrame
            shpT.Top = .TextRange.Lines(l).BoundTop '+ .MarginTop
            shpT.Height = .TextRange.Lines(l).BoundHeight
        End With
        '이름 부여
        shpT.Name = shp.Name & "_L" & l
        
        '텍스트 분할
        TextSplit shpT
        DoEvents
        shpT.Delete
        
    Next l
    
    shp.Visible = msoFalse
    
End Sub

Function TextSplit(oShp As Shape)
    
    Dim sld As Slide, shp As Shape, tr As TextRange
    Dim Str() As String
    Dim i As Integer, l As Integer

    Set sld = oShp.Parent
        
    Str() = Split(oShp.TextFrame.TextRange, SplitChar)
    If UBound(Str) < 1 Then
        MsgBox "구분문자가 없습니다."
    Else
        l = 1
        For i = LBound(Str) To UBound(Str)
            If Len(Str(i)) > 0 Then
                Set shp = oShp.Duplicate(1) ' 복사하면 애니메이션까지 복사됨.
                Set tr = shp.TextFrame.TextRange
                replaceAll tr, " ", Chr(164)
                shp.Name = oShp.Name & "_" & (i + 1)
                '이전 부분 삭제
                If l > 1 Then tr.Characters(1, l - 1).Delete
                '이후 부분 삭제
                tr.Characters(Len(Str(i)) + 1, Len(oShp.TextFrame.TextRange) - Len(Str(i))).Delete
                replaceAll tr, Chr(164), " "
                tr.Parent.WordWrap = msoFalse
                With oShp.TextFrame.TextRange.Characters(l, Len(Str(i)))
                    shp.Left = .BoundLeft - oShp.TextFrame.MarginLeft
                    shp.Top = oShp.Top
                    shp.Width = .BoundWidth + oShp.TextFrame.MarginLeft + oShp.TextFrame.MarginRight
                    shp.Height = oShp.Height
                End With
            End If
            l = l + Len(Str(i)) + 1
        Next i
    End If
    
End Function

Function replaceAll(ByRef oTr As TextRange, find As String, repl As String)
    
    Dim tr As TextRange
   
    Set tr = oTr.Characters.Replace(find, repl)
    While Not tr Is Nothing
        Set tr = oTr.Characters.Replace(find, repl)
    Wend
    
End Function

 

실행 화면

​

​

행이 여러 개인 경우도 모든 단어를 텍스트 상자로 분리해줍니다.

 

- 이제 분리된 텍스트 상자에 애니메이션을 적용할 수 있습니다.

- 이미 애니메이션이 적용된 텍스트 상자인 경우 애니메이션이 유지됩니다.

- 기존 텍스트상자는 숨김처리됩니다.

- SplitChar를 '/'과 같이 다른 문자로 바꿔도 됩니다.

​

 

첨부파일 참고 하세요.

TextSplit2.pptm

0.07MB

 

 

관련: 지식인