파워포인트 표안의 셀 병합여부, 첫번째 셀인지, 병합된 순서, 범위 등 알아내기

 

  Recently, I dug into the mystery of merged cells in the PowerPoint table. I ended up figuring out my own methods to deal with merged cells.
  Please refer to the following link: https://stackoverflow.com/a/74563860/6354194

There are a few useful functions for merged cells:
    1. test if the cell is merged
    2. test if the cell is the first(Top-Left) cell of the merged area
    3. get the index no. of the cells in the merged area, top to bottom, left to right
    4. get the width and height of merged area
    5. test if the given cells are within a merged area

 

VBA에서 파워포인트 표안의 셀이 병합되었는지 확인하는 것이 실제로는 간단하지 않습니다. 

 

엑셀에서도 병합된 셀의 경우 처리하는 것이 쉽지 않습니다. 그나마 엑셀은 MeredArea 등으로 지원을 하지만 파워포인트에서는 셀이 병합되었는지조차 쉽게 알 수 없습니다.

 

셀이 병합되었는지 알아내는 제일 좋은 방법은 셀의 넓이/높이와 열/행의 크기와 비교하는 방법입니다. 예를 들어 셀의 Width가 해당 Column의 Width보다 크다면 현재 셀은 가로로 병합된 셀에 속하는 것을 알 수 있습니다.

'simply check if the cell is merged
Function IsMerged(oTbl As Table, rr As Integer, cc As Integer) As Boolean

    Dim c As Cell
    
    'the current cell
    Set c = oTbl.Cell(rr, cc)
    
    'Check the width and height
    If c.Shape.Width <> oTbl.Columns(cc).Width Then IsMerged = True
    If c.Shape.Height <> oTbl.Rows(rr).Height Then IsMerged = True
    
End Function

 

여기에서부터 출발해서 파워포인트에서 지원하지 않는, 병합된 셀과 관련한 함수들이 절실히 필요합니다.

 

병합된 셀에 값을 넣을 때는 첫번째 셀에만 넣으면 됩니다. 그런데 첫번째 셀 즉, 병합된 셀영역 중 가장 첫번째행의 맨 좌측 셀인지 알아내는 것도 쉽지 않습니다. 조건을 비교해서 첫번째 셀인지 알아내야 합니다. 세로 병합된 경우 첫번째 행이라면 첫번째 셀입니다. 가로로 병합된 경우 현재 셀로 부터 왼쪽으로 몇개의 셀이 합쳐졌는지 확인해서 1개인 경우 세로로도 첫번째 행인 경우 병합된 셀들의 가장 첫번째셀임을 알아낼 수 있습니다.

그 외에도 현재 셀이 병합된 전체 셀에서 몇번째 셀인지, 병합된 셀의 가로, 세로 크기는 몇개인지, 특정 셀이 병합된 영역안에 있는지 판단하는 것도 필요합니다.

 

특히 병합된 셀영역에서 몇번째 셀인지 알아내는 것은 그리 쉽지 않습니다. 아래 GetMergedIndex함수처럼 병합된 영역에서 몇번째 셀인지 알아낼 수 있습니다. 먼저 몇번째 열의 위치인지 알아내고 현재 셀 위로 몇개의 행이 병합되었는지 파악해서 병합된 행수와 행마다의 열수를 곱해서 모두 합치면 병합된 셀의 순번(index)을 알아낼 수 있습니다.

'Returns the index no. of the cell in the merged area
Function getMergedIndex(oTbl As Table, rr As Integer, cc As Integer) As Integer

    Dim c As Cell
    Dim i As Integer, j As Integer, mc As Integer
    
    Set c = oTbl.Cell(rr, cc)
    
    'horizontally merged
    If c.Shape.Width <> oTbl.Columns(cc).Width Then

        'get the horizontal index
        For i = 1 To cc - 1
            If oTbl.Cell(rr, cc - i).Shape.Left <> c.Shape.Left Then Exit For
        Next i
        
        'get the merged row count above
        For j = 1 To rr - 1
            If oTbl.Cell(rr - j, cc).Shape.Top <> c.Shape.Top Then Exit For
        Next j
        'if merged both horizontally and vertically
        If j > 1 Then
            'get the column count of the merged cells above
            mc = oTbl.Cell(rr - 1, cc).Shape.Width / oTbl.Columns(cc).Width
            'For mc = 1 To oTbl.Columns.Count - cc
            '    If oTbl.Cell(rr - 1, cc + mc).Shape.Left <> c.Shape.Left Then Exit For
            'Next mc
            'mc = i + mc - 1
            'add up to the merged cells above
            getMergedIndex = (j - 1) * mc + i
        Else
            getMergedIndex = i
        End If
        
    'vertically merged
    ElseIf c.Shape.Height <> oTbl.Rows(rr).Height Then

        For i = 1 To rr - 1
            If oTbl.Cell(rr - i, cc).Shape.Top <> c.Shape.Top Then Exit For
        Next i
        getMergedIndex = i
    Else
        'not merged
    End If
    
End Function

[  ][  ][  ][  ][  ][  ][  ][  ][  ][01]
[  ][01][02][03][04][  ][  ][  ][  ][02]
[  ][05][06][07][08][  ][  ][  ][  ][  ]
[  ][  ][01][02][03][04][01][02][  ][  ]
[  ][  ][05][06][07][08][03][04][  ][  ]
[  ][  ][  ][  ][  ][  ][05][06][  ][  ]
[01][02][03][04][01][  ][07][08][01][02]
[05][06][07][08][02][  ][  ][  ][03][04]
[01][02][03][04][  ][  ][  ][  ][05][06]
[05][06][07][08][  ][  ][  ][  ][07][08]

 

 

 

이렇게 병합된 셀과 관련한 유용한 함수들을 만들어 모아 보았습니다.

 

'https://stackoverflow.com/a/74563860/6354194

'In VBA, we can compare the height of the cell and the row. If they are different, it means the cell is merged vertically. The following function determines whether the given cell is merged vertically or horizontally.


'simply check if the cell is merged
Function IsMerged(oTbl As Table, rr As Integer, cc As Integer) As Boolean

    Dim c As Cell

    'the current cell
    Set c = oTbl.Cell(rr, cc)

    'Check the width and height
    'horizonatally merged
    If c.Shape.Width <> oTbl.Columns(cc).Width Then IsMerged = True
    'vertically merged
    If c.Shape.Height <> oTbl.Rows(rr).Height Then IsMerged = True

End Function


'We can also identify if the cell is the Top-Left(first) cell of the merged area by following method:

Function isTopLeftCell(oTbl As Table, rr As Integer, cc As Integer) As Boolean
    Dim i As Integer
    
    With oTbl.Cell(rr, cc).Shape
        'horizontally merged
        If .Width <> oTbl.Columns(cc).Width Then
            'count the left cells merged from the currnet cell
            For i = 1 To cc - 1
                If oTbl.Cell(rr, cc - i).Shape.Left <> .Left Then Exit For
            Next i
            'count the rows above
            If i = 1 Then
                For i = 1 To rr - 1
                    If oTbl.Cell(rr - i, cc).Shape.Top <> .Top Then Exit For
                Next i
                If i = 1 Then isTopLeftCell = True: Exit Function
            End If
        'vertically merged
        ElseIf .Height <> oTbl.Rows(rr).Height Then
            For i = 1 To rr - 1
                If oTbl.Cell(rr - i, cc).Shape.Top <> .Top Then Exit For
            Next i
            If i = 1 Then isTopLeftCell = True: Exit Function
        Else
            'isTopLeftCell = False
        End If
    End With
    
End Function


'The following returns the width(ww) and height(hh) of the merged area

    'Returns the width and height of the merged area
Function getMergedArea(oTbl As Table, rr As Integer, cc As Integer, ByRef ww As Integer, ByRef hh As Integer)
    Dim c As Cell
    Dim i As Integer, j As Integer
    
    Set c = oTbl.Cell(rr, cc)
    'ww = 1: hh = 1
    
    ww = c.Shape.Width / oTbl.Columns(cc).Width
    hh = c.Shape.Height / oTbl.Rows(rr).Height

End Function


'If you want get the index no. of the cell in the merged area: (which is the result of my hard working!)

    'Returns the index no. of the cell : top to bottom, left to right
Function getMergedIndex(oTbl As Table, rr As Integer, cc As Integer) As Integer

    Dim c As Cell
    Dim i As Integer, j As Integer, mc As Integer
    
    Set c = oTbl.Cell(rr, cc)
    
    'horizontally merged
    If c.Shape.Width <> oTbl.Columns(cc).Width Then

        'get the horizontal index
        For i = 1 To cc - 1
            If oTbl.Cell(rr, cc - i).Shape.Left <> c.Shape.Left Then Exit For
        Next i
        
        'get the merged row count above
        For j = 1 To rr - 1
            If oTbl.Cell(rr - j, cc).Shape.Top <> c.Shape.Top Then Exit For
        Next j
        'if merged both horizontally and vertically
        If j > 1 Then
            'get the column count of the merged cells above
            mc = oTbl.Cell(rr - 1, cc).Shape.Width / oTbl.Columns(cc).Width
            'For mc = 1 To oTbl.Columns.Count - cc
            '    If oTbl.Cell(rr - 1, cc + mc).Shape.Left <> c.Shape.Left Then Exit For
            'Next mc
            'mc = i + mc - 1
            'add up to the merged cells above
            getMergedIndex = (j - 1) * mc + i
        Else
            getMergedIndex = i
        End If
        
    'vertically merged
    ElseIf c.Shape.Height <> oTbl.Rows(rr).Height Then

        For i = 1 To rr - 1
            If oTbl.Cell(rr - i, cc).Shape.Top <> c.Shape.Top Then Exit For
        Next i
        getMergedIndex = i
    Else
        'not merged
    End If
    
End Function

''For example:
''[  ][  ][  ][  ][  ][  ][  ][  ][  ][  ]
''[  ][01][02][03][04][  ][  ][  ][  ][  ]
''[  ][05][06][07][08][  ][  ][  ][  ][  ]
''[  ][  ][01][02][03][04][01][02][  ][  ]
''[  ][  ][05][06][07][08][03][04][  ][  ]
''[  ][  ][  ][  ][  ][  ][05][06][  ][  ]
''[01][02][03][04][01][  ][07][08][01][02]
''[05][06][07][08][02][  ][  ][  ][03][04]
''[01][02][03][04][  ][  ][  ][  ][05][06]
''[05][06][07][08][  ][  ][  ][  ][07][08]


'finally, check if two given cells are contained within a merged area

Function isMerged2(oTbl As Table, r1%, c1%, r2%, c2%) As Boolean
    If oTbl.Cell(r1, c1).Shape.Left = oTbl.Cell(r2, c2).Shape.Left And _
        oTbl.Cell(r1, c1).Shape.Top = oTbl.Cell(r2, c2).Shape.Top And _
        oTbl.Cell(r1, c1).Shape.Width = oTbl.Cell(r2, c2).Shape.Width And _
        oTbl.Cell(r1, c1).Shape.Height = oTbl.Cell(r2, c2).Shape.Height Then _
            isMerged2 = True
End Function

 

이제 아래와 같은 코드로 실제 셀이 병합되었는지 등을 실행창에서 테스트해볼 수 있습니다.

 

마지막에 있는 Select 방식은 위와는 다른 방식으로 셀을 선택해서 다른 셀도 선택되었는지 확인해서 셀의 병합 여부를 판단하는 방식입니다.

'Visually print out the merged status of each cell in the table
Sub Test_IsMerged()
    Dim r As Integer, c As Integer
    Dim shp As Shape
    Dim str As String
    
    If ActiveWindow.Selection.Type = ppSelectionNone Then _
        MsgBox "Select a table first": Exit Sub
    Set shp = ActiveWindow.Selection.ShapeRange(1)
    
    If shp.Type = msoTable Then
        For r = 1 To shp.Table.Rows.Count
            str = ""
            For c = 1 To shp.Table.Columns.Count
                'Debug.Print r, c, IsMerged(shp.Table, r, c)
                str = str & IIf(IsMerged(shp.Table, r, c), "[M]", "[ ]")
            Next c
            Debug.Print str
        Next r
    End If
End Sub

'list the top-left cells of each merged area
Sub Test_isTopLeftCell()
    Dim r As Integer, c As Integer, i As Integer
    Dim shp As Shape
    
    If ActiveWindow.Selection.Type = ppSelectionNone Then _
        MsgBox "Select a table first": Exit Sub
    Set shp = ActiveWindow.Selection.ShapeRange(1)
    
    If shp.Type = msoTable Then
        For r = 1 To shp.Table.Rows.Count
            For c = 1 To shp.Table.Columns.Count
                If isTopLeftCell(shp.Table, r, c) Then
                    i = i + 1
                    Debug.Print "First cell of the merged area #" & i & " starting at " & r; ", " & c
                End If
            Next c
        Next r
    End If
    
End Sub

'visually print out the merged index no. of each cell in the given table
'Index no. is horizontally first and vertically later
Sub Test_getMergedIndex()
    Dim r As Integer, c As Integer
    Dim shp As Shape
    Dim str As String
    Dim i As Integer
    
    If ActiveWindow.Selection.Type = ppSelectionNone Then _
        MsgBox "Select a table first": Exit Sub
    Set shp = ActiveWindow.Selection.ShapeRange(1)
    
    If shp.Type = msoTable Then
        For r = 1 To shp.Table.Rows.Count
            str = ""
            For c = 1 To shp.Table.Columns.Count
                'Debug.Print r, c, getMergedIndex(shp.Table, r, c)
                i = getMergedIndex(shp.Table, r, c)
                str = str & IIf(i > 0, "[" & Format(i, "00") & "]", "[  ]")
            Next c
            Debug.Print str
        Next r
    End If
End Sub


''Merged area #1 starting at 2, 2:          width: 4, height: 2
''Merged area #2 starting at 4, 3:          width: 4, height: 2
''Merged area #3 starting at 4, 7:          width: 2, height: 4
''Merged area #4 starting at 7, 1:          width: 4, height: 2
''Merged area #5 starting at 7, 5:          width: 1, height: 2
''Merged area #6 starting at 7, 9:          width: 2, height: 4
''Merged area #7 starting at 9, 1:          width: 4, height: 2

'visually test the merged area
Sub Test_getMergedArea()
    Dim r As Integer, c As Integer
    Dim shp As Shape
    Dim w As Integer, h As Integer, i As Integer
    
    If ActiveWindow.Selection.Type = ppSelectionNone Then _
        MsgBox "Select a table first": Exit Sub
    Set shp = ActiveWindow.Selection.ShapeRange(1)
    
    If shp.Type = msoTable Then
        For r = 1 To shp.Table.Rows.Count
            For c = 1 To shp.Table.Columns.Count
                If isTopLeftCell(shp.Table, r, c) Then
                'If getMergedIndex(shp.Table, r, c) = 1 Then
                    i = i + 1
                    Debug.Print "Merged area #" & i & " starting at " & r; ", " & c & ": ",
                    Call getMergedArea(shp.Table, r, c, w, h)
                    Debug.Print "width: " & w & ", height: " & h
                End If
            Next c
        Next r
    End If
    
End Sub

''get the width and height of the merged area if given a cell location
''Merged area at 8, 5:        width: 1, height: 2
Sub Test2_getMergedArea()
    Dim r As Integer, c As Integer
    Dim shp As Shape
    Dim w As Integer, h As Integer, i As Integer
    
    If ActiveWindow.Selection.Type = ppSelectionNone Then _
        MsgBox "Select a table first": Exit Sub
    Set shp = ActiveWindow.Selection.ShapeRange(1)
    
    r = 8: c = 5
    Debug.Print "Merged area at " & r; ", " & c & ": ",
    Call getMergedArea(shp.Table, r, c, w, h)
    Debug.Print "width: " & w & ", height: " & h

End Sub

Sub Test_IsMerged2()
    Dim r1%, c1%, r2%, c2%
    Dim tTbl As Table
    
    r1 = 10: c1 = 10: r2 = 8: c2 = 9
    Set tTbl = ActiveWindow.Selection.ShapeRange(1).Table
    If isMerged2(tTbl, r1, c1, r2, c2) Then Debug.Print "Merged" Else Debug.Print "Not merged"
    
End Sub

''check if two cells are merged
Function isMerged2(oTbl As Table, r1%, c1%, r2%, c2%) As Boolean
    If oTbl.Cell(r1, c1).Shape.Left = oTbl.Cell(r2, c2).Shape.Left And _
        oTbl.Cell(r1, c1).Shape.Top = oTbl.Cell(r2, c2).Shape.Top And _
        oTbl.Cell(r1, c1).Shape.Width = oTbl.Cell(r2, c2).Shape.Width And _
        oTbl.Cell(r1, c1).Shape.Height = oTbl.Cell(r2, c2).Shape.Height Then _
            isMerged2 = True
End Function

Function IsMergedSelect(oTbl As Table, rr As Integer, cc As Integer) As Boolean

    Dim i As Integer
    Dim c(0 To 4) As Cell   ' five cells including the current one
    
    'Get ready to select
    ActiveWindow.Selection.Unselect
    
    'First, select the current cell
    Set c(0) = oTbl.Cell(rr, cc)        'center(current cell)
    c(0).Select
    
    'Check if any other cell is also selected
    'Especially, cehck for the four cells around the current one
    If cc > 1 Then Set c(1) = oTbl.Cell(rr, cc - 1)                     'one column left
    If rr > 1 Then Set c(2) = oTbl.Cell(rr - 1, cc)                     'one row up(top)
    If cc < oTbl.Columns.Count Then Set c(3) = oTbl.Cell(rr, cc + 1)    'one column right
    If rr < oTbl.Rows.Count Then Set c(4) = oTbl.Cell(rr + 1, cc)       'one row down(bottom)
    
    'If one of the four cells is also selected, then it means they are merged!
    For i = 1 To 4
        If Not c(i) Is Nothing Then
             If c(i).Selected Then IsMergedSelect = True: Exit For
        End If
    Next i
    
    'Reset the selection
    ActiveWindow.Selection.Unselect
    
End Function

Function getMergedIndexSel(oTbl As Table, rr As Integer, cc As Integer) As Integer

    Dim i As Integer, j As Integer
    Dim c(0 To 4) As Cell   ' five cells including the current one
    
    'Get ready to select
    ActiveWindow.Selection.Unselect
    
    'First, select the current cell
    Set c(0) = oTbl.Cell(rr, cc)        'center(current cell)
    c(0).Select
    
    'Check if any other cell is also selected
    'Especially, cehck for the four cells around the current one
    If cc > 1 Then Set c(1) = oTbl.Cell(rr, cc - 1)                     'one column left
    If rr > 1 Then Set c(2) = oTbl.Cell(rr - 1, cc)                     'one row up
    If cc < oTbl.Columns.Count Then Set c(3) = oTbl.Cell(rr, cc + 1)    'one column right
    If rr < oTbl.Rows.Count Then Set c(4) = oTbl.Cell(rr + 1, cc)       'one row down

    
    'If one of the four cells is also selected, then it means they are merged!
    For i = 1 To 4
        If Not c(i) Is Nothing Then
             If c(i).Selected Then

                'to the left
                If i = 1 Then
                    j = 0
                    Do
                        If cc - 1 - j = 1 Then Exit Do  'first column
                        j = j + 1
                    Loop While oTbl.Cell(rr, cc - 1 - j).Selected
                    getMergedIndexSel = j + 1
                'to the top
                ElseIf i = 2 Then
              
                      If rr - 2 >= 1 Then  'first row
                          j = 0
                        While oTbl.Cell(rr - 2 - j, cc).Selected
                            j = j + 1
                        Wend
                    End If
                    getMergedIndexSel = j + 2
                'right or down
                Else
                    getMergedIndexSel = 1
                End If

                Exit For
            End If
        End If
    Next i
    
    'Reset the selection
    ActiveWindow.Selection.Unselect
    
End Function

 

샘플 테스트 파일 첨부합니다.

 

IsMerged3.pptm

0.09MB