Как разбить все вертикально объединенные ячейки в таблице Microsoft Word, используя слово vba? - PullRequest
Новая
       83

Как разбить все вертикально объединенные ячейки в таблице Microsoft Word, используя слово vba?

0 голосов
/ 05 декабря 2018

У меня есть таблица слов, которая содержит многочисленные вертикальные слияния.

Мне нужно разбить все объединяемые ячейки на отдельные ячейки с предыдущим значением в объединенных ячейках.

1 Ответ

0 голосов
/ 05 декабря 2018

Я искал много ссылок, но не смог найти другого более короткого способа разбить все вертикальные слияния в ячейке таблицы в Word.

Эта функция возьмет первую таблицу в слове и удалитвсе вертикальные слияния для всех ячеек таблицы в MS Word. 

Function SplitVerticalMerge()
    'Created by Chandraprakash [Yoh]
    Dim i As Long, j As Long, k As Long, cols As Long, m As Long
    Dim sData() As Variant
    Dim oTable As Table
    Dim oCell As Cell
    Dim oRng As Range
    Dim sText As String
    Dim sRow As String
    Dim iRow As Long

    'Rows of Merged and NonMerged cells in Table
    Dim oColl1 As New Collection

    'Row with number of merged cells in Table (Vertical Split Number)
    Dim oColl2 As New Collection

    Set oTable = ActiveDocument.Tables(1)
    With oTable

        'Load all the Table cell index
        ReDim sData(1 To .Rows.Count, 1 To .Columns.Count)
        Set oCell = .Cell(1, 1)
        Do While Not oCell Is Nothing
            sData(oCell.RowIndex, oCell.ColumnIndex) = oCell.RowIndex & "," & oCell.ColumnIndex
            Set oCell = oCell.Next
        Loop

        '1. Mark the merged cell as "X"
        '2. Mark the non merged cell as "A"
        '3. Load the result for each row to Collection1
        For i = 1 To UBound(sData)
            sRow = ""
            For j = 1 To UBound(sData, 2)
                sRow = sRow & IIf(IsEmpty(sData(i, j)), "X", "A") ' & "|"
            Next j
            oColl1.Add sRow
        Next i

        For cols = 1 To oTable.Columns.Count
            'Load one by one Row with number of merged cells in Table (Vertical Split Number)
            Set oColl2 = Nothing
            j = 1
            For i = oColl1.Count To 1 Step -1
                '"X" - Merged
                If Mid(oColl1(i), cols, 1) = "X" Then
                    j = j + 1
                    k = j
                '"A" - NotMerged
                Else
                    k = j
                    j = 1
                End If
                If j = 1 Then oColl2.Add k
            Next i

            iRow = oTable.Columns(cols).Cells.Count
            k = iRow
            For j = 1 To oColl2.Count
                For i = oColl2.Count To 1 Step -iRow
                    'cols - Column Number
                    'k - cell row number in column (cols)
                    'j - Split number for the cell (k)

                    'Split the cell by above attributes defined
                    oTable.Columns(cols).Cells(k).Split oColl2(j), 1

                    '1. Enter if merged cell is split (j>1)
                    '2. Will fill the values for split empty cell with previous merged cell value
                    If oColl2(j) > 1 Then
                        For m = 1 To oColl2(j) - 1
                            oTable.Columns(cols).Cells(k + m).Range.Text = oTable.Columns(cols).Cells(k).Range.Text
                        Next m
                    End If

                    k = k - 1
                Next i
            Next j
        Next cols

        'To avoid application freezing
        DoEvents
    End With

lbl_Exit:
    Set oColl1 = Nothing
    Set oColl2 = Nothing

    Set oTable = Nothing
    Set oCell = Nothing
    Set oRng = Nothing
    Exit Function
End Function

Ссылка: Базовый код Грэма Майора - MS MVP (Word) URL: http://www.vbaexpress.com/forum/showthread.php?59760-Unmerging-Vertically-merged-cells

...