세로로 긴 표(Table) 자동으로 자르기

관련: 지식인

 

 

파워포인트에는 표를 자동으로 잘라주는 기능을 지원하지는 않습니다.

텍스트 상자의 경우 2페이지로 나눠주는 기능이 MS에서  시험중인 걸로 압니다.

텍스트상자를 자동으로 자르는 것은 지난 게시글을 참고하세요.

 

또한 표를 ListBox로 변환하거나 웹페이지 ScrollArea로 만들어서 Web Viewer로 스크롤할 수 있게 만드는 방법도 있습니다.

​

여기서는 세로로 긴 표(테이블)을 아래와 같은 vba를 이용해서 자동으로 페이지별로 나눠주는 방법을 소개합니다.

 

 

 

aLT-f11 창에서 삽입>모듈을 추가한 후에 아래 코드를 붙여넣고 코드창을 닫은 다음

표를 선택하고 aLT-f8 누르고 SplitTable 을 실행하세요.

 

Option Explicit

Dim TableTop As Single  '기준 표의 y값

Sub SplitTable()

    Dim sld As Slide, shp As Shape
    Dim tbl As Table, tblNew As Table, temp As Table
    Dim r%, p%, SH!, pageEnd%, Found As Boolean
    
    With ActiveWindow
        If .Selection.Type = ppSelectionNone Or .Selection.Type = ppSelectionSlides _
            Then MsgBox "표를 선택해주세요.": Exit Sub
        Set shp = .Selection.ShapeRange(1)
        If shp.Type <> msoTable Then MsgBox "표를 선택해주세요.": Exit Sub
    End With
    
    Set sld = shp.Parent
    SH = ActivePresentation.PageSetup.SlideHeight
    TableTop = shp.Top
    Set tbl = shp.Table
    p = 1
    
    'Add new slide(page) and paste the current table there
    Set tblNew = CopyNewTable(tbl, 0, p)
    
    Do While Not tblNew Is Nothing
        
        With tblNew.Rows
            
            'look for the edge of the page
            Found = False
            For r = 1 To .Count
                If .Item(r).Cells(1).Shape.Top + .Item(r).Cells(1).Shape.Height > SH Then
                    pageEnd = r - 1
                    Found = True
                    Exit For
                End If
            Next r

            If Found Then
                p = p + 1
                'Debug.Print pageEnd
                Set temp = CopyNewTable(tblNew, pageEnd, p)
                'If MsgBox(p, vbOKCancel) = vbCancel Then Exit Sub
            
                'delete bottom abundant rows
                For r = .Count To pageEnd + 1 Step -1
                    .Item(r).Delete
                Next r
            Else
                Exit Do
            End If
            Set tblNew = temp

        End With
    Loop
    If p Then MsgBox p & "페이지로 분리 완료!", vbInformation
End Sub

Function CopyNewTable(ByVal oTbl As Table, pEnd As Integer, page As Integer) As Table
    Dim oSld As Slide, oSldNew As Slide, cLayout As CustomLayout
    Dim oShp As Shape, k As Long
    
    'create new slide and paste table
    Set oSld = oTbl.Parent.Parent 'current slide
    Set cLayout = oSld.CustomLayout
    Set oSldNew = ActivePresentation.Slides.AddSlide(oSld.SlideIndex + 1, cLayout)
    oTbl.Parent.Copy
    DoEvents
    k = oSldNew.Shapes.Count
    Set oShp = oSldNew.Shapes.Paste(1)
    While oSldNew.Shapes.Count <= k: DoEvents: Wend
    oShp.Name = "Table_" & page
    
    'remove top rows in the table
    For k = pEnd To 1 Step -1
        oShp.Table.Rows(k).Delete
    Next k
    oShp.Top = TableTop 'maintain the top location
    
    'return
    Set CopyNewTable = oShp.Table
 
End Function

 

실행화면 캡쳐:

 

내부적으로 새로운 슬라이드를 추가하고 현재 표를 복사한 다음 슬라이드 높이를 벗어나는 행들은 삭제합니다.

그리고 또 새로운 슬라이드를 추가하고 표를 복사하고 남은 윗부분과 아래부분을 삭제하는 동작을 반복합니다.

 

표의 행이나 열을 추가하는 것이나 표의 행이나 셀을 선택하는 동작은 VBA로도 쉽지 않기 때문에

원본 표를 복사해서 필요없는 부분은 삭제하는 방식으로 구현하였습니다.

 

파워포인트 표는 느린 개체이므로 표가 길거나 텍스트가 많거나 셀이 많을수록 동작이 현저히 느려집니다.

그래서 표는 한번에 75행/열이상 만들 수가 없게 제한도 걸려 있습니다.

 

표의 셀들이 병합된 경우 특히 위,아래 셀이 병합된 경우

앞뒤 슬라이드에서 반복되게 됩니다.

 

열이 슬라이드 폭을 벗어난 경우는 반영하지 않았습니다.

제목셀을 반복하는 것도 반영되어 있지 않습니다.

 

나머지는 첨부파일을 참고하세요.

 

 

SplitTable1.pptm

0.08MB