[Split TextBox] 텍스트박스 자동 분할

 

인터넷 등에서 텍스트를 가져와서 파워포인트 슬라이드에 붙여넣는 경우

내용이 길어서 아래가 잘리는 경우가 많습니다.

이 때 일일이 복사해서 슬라이드마다 필요한 부분을 수작업으로 나눠주는 것이 번거롭습니다.

 

예를 들어, 노래가사, 뉴스기사 전문, 영어문장, 프로그램 소스 등

텍스트 길이가 길수록 이런 기능이 아주 절실합니다.

특히 문장 사이에 간격이 필요한 경우는 더욱 길어져서 텍스트를 자동으로 나눠주면 좋겠다는 생각이 듭니다.

게다가 파워포인트는 아래로 길수록 조금만 잘못스크롤하면

다음슬라이드로 넘어가버리기 쉬어서 작업도 쉽지 않습니다.

 

바로 이렇게 텍스트박스가 긴 경우 아래로 긴 텍스트박스를 

한 슬라이드에 맞는 크기로 각각 나눠서 슬라이드를 생성해주는 매크로입니다.

 

 

아래 사용법 소개 영상을 참고하세요.

 

내부적으로 슬라이드 높이를 재서 몇줄이 적당한가를 측정한 다음

현재 슬라이드를 계속 복제하면서 

텍스트 박스의 내용을 각각의 슬라이드에 넣어주는 방식입니다.

나뉘어진 첫번째 텍스트박스의 길이(줄수)를 기준으로 작업하기 때문에

최초 텍스트박스의 폰트는 하나의 사이즈로 미리 통일해주는 것이 좋습니다.

 

1. 먼저 인터넷 등에서 복사해 온 글을 붙여넣습니다.

슬라이드 우클릭해서 텍스트 내용만 붙여넣는 것이 좋습니다.

TED의 경우 시간이 필요없으면 서식유지로 붙여넣는 것도 좋습니다.

2. 현재 선택된 텍스트박스를 대상으로 하기 때문에

기본 텍스트박스의 크기를 조절하는 것이 좋습니다.

글자크기, 줄간격, 좌우 여백, 글자 폰트, 자간 등을 미리 수정합니다.

3. 이제 개발도구 - 매크로 에서 SplitTextBox 를 선택해주면 됩니다.

매크로 실행전 반드시 대상 텍스트박스를 선택한 상태여야 합니다.

만일 새로운 문서를 시작했다면 SplitTextBox 매크로가 들어있는 파일을 아래에서 선택해주면 매크로가 뜹니다.

참고로 ZapCRreturns 는 붙여넣은 텍스트박스에서 빈줄 엔터를 자동으로 삭제해주는 매크로입니다.

 

 

4. 실행 결과입니다. 기존 슬라이드는 다음에 새로운 분할 슬라이드가 생성되니 기존 슬라이드는 삭제해도 되겠습니다.

 

 

분할된 텍스트박스 및 슬라이드는 처음 텍스트박스와 슬라이드의 서식을 그대로 복제해오기 때문에

미리 텍스트 서식(글자크기, 폰트, 색깔, 줄간격, 정렬, 도형서식)과 슬라이드의 배경 등을 조절해놓는 것이 좋습니다.

 

 

매크로내용:

Option Explicit
Const TopMargin As Single = 20

'Split the selected Textbox into slides automatically
'- add slides and move the splitted textboxes to center of each slide
Sub SplitTextbox()

    Dim pres As Presentation
    Dim oldSld As Slide, sld As Slide
    Dim shp As Shape
    Dim shpName As String
    Dim SW As Single, SH As Single
    Dim i As Integer, l As Integer, linesTotal As Integer, linesPage As Integer
    Dim tlines() As String
    
    On Error Resume Next
    Set pres = ActivePresentation
    Set oldSld = ActiveWindow.Selection.SlideRange(1)
    Set shp = ActiveWindow.Selection.ShapeRange(1)
    shpName = shp.Name
    shp.TextFrame.AutoSize = ppAutoSizeShapeToFitText   '도형크기 변하게
    If oldSld Is Nothing Or shp Is Nothing Then _
        MsgBox "먼저 텍스트박스를 선택하세요.", vbInformation + vbOKOnly: Exit Sub
    On Error GoTo 0
    
    With pres.PageSetup
        SW = .SlideWidth: SH = .SlideHeight
    End With
    
    linesTotal = shp.TextFrame.TextRange.lines.Count
    ReDim tlines(1 To linesTotal)
    For l = 1 To linesTotal
        tlines(l) = shp.TextFrame.TextRange.lines(l)
    Next l
    
    i = 1
    Do
    
        oldSld.Duplicate(1).MoveTo oldSld.SlideIndex + i
        Set sld = pres.Slides(oldSld.SlideIndex + i)
        Set shp = sld.Shapes(shpName)
            
        shp.Top = TopMargin
        shp.Left = SW / 2 - shp.Width / 2
        'Debug.Print "page: " & i
        'Debug.Print linesPage * (i - 1) + 1; " to "; linesPage * i
        With shp.TextFrame.TextRange
            If i = 1 Then
                For l = linesTotal To 1 Step -1
                    '  한 페이지당 줄수 계산
                         If shp.Top + shp.Height <= SH - TopMargin _
                            Then linesPage = l: Exit For
                        .lines(l).Delete
                Next l
            Else
                .Text = ""
                For l = linesPage * (i - 1) + 1 To linesPage * i
                    .lines.InsertAfter tlines(l)
                    If l >= linesTotal Then Exit Do
                Next l
                
            End If
            i = i + 1
        End With

    Loop
    
    MsgBox "작업 완료!" & vbNewLine & _
        "총 줄수: " & linesTotal & vbNewLine & _
        "페이지당 줄수: " & linesPage & vbNewLine & _
        "분할 페이지 수: " & i, vbInformation + vbOKOnly

End Sub

Sub ZapCReturns()

    Dim pres As Presentation
    Dim sld As Slide
    Dim shp As Shape
    Dim l As Integer
    
    On Error Resume Next
    Set pres = ActivePresentation
    Set sld = ActiveWindow.Selection.SlideRange(1)
    Set shp = ActiveWindow.Selection.ShapeRange(1)
    shp.TextFrame.AutoSize = ppAutoSizeShapeToFitText   '도형크기 변하게
    If sld Is Nothing Or shp Is Nothing Then _
        MsgBox "먼저 텍스트박스를 선택하세요.", vbInformation + vbOKOnly: Exit Sub
    On Error GoTo 0
    
    With shp.TextFrame.TextRange
        For l = .lines.Count To 2 Step -1
            'If .lines(l).Text = Chr(13)  And .lines(l - 1).Text = Chr(13) Then
            If .lines(l).Text = Chr(13) Then _
                .lines(l).Delete
        Next l
    End With
    
End Sub

 

매크로파일 첨부합니다.

SplitTextboxIntoSlides2.pptm

0.08MB

 

문단 사이의 Paragraph Break를 삭제하는 버전을 추가합니다.

SplitTextboxIntoSlides3.pptm

0.09MB