Если у меня есть такая таблица:

A B
C D
E F

Когда я удаляю ячейку B, я хочу, чтобы все ячейки сместились на одно место по направлению к A следующим образом:

A C
D E
F

Как этого добиться? Кроме того, как получить противоположное - вставить одну ячейку куда-нибудь и сделать так, чтобы все остальные ячейки переместились в одно место?

2 ответа2

1

Несколько дней назад мне нужно было что-то наподобие того, о котором просил кнезмило, и я не нашел ничего, чтобы сделать это. Итак, я создал макрос VBA (Word 2016) для этого. Макрос работает четырьмя различными способами:

  1. Сдвиньте все ячейки вправо до конца таблицы (Public Sub MoveCellsRight)
  2. Сдвигайте все ячейки вправо до первой пустой ячейки (Public Sub MoveCellsRightFirstBlankCell)
  3. Сдвиньте все ячейки влево до начала таблицы (Public Sub MoveCellsLeft)
  4. Сдвигайте все ячейки влево до первой пустой ячейки (Public Sub MoveCellsLeftFirstBlankCell)

Этот макрос НЕ БУДЕТ:

  1. Работа с таблицами внутри клетки.
  2. Работа с разделенными ячейками (каждая строка должна иметь одинаковое количество столбцов).
  3. Сохраните формат ячейки. (Я надеюсь, что кто-то улучшит этот макрос, добавив эту функцию).

Вот макрос:


Option Explicit

Dim vmCurrentTableIndex As Integer
Dim vmCurrentTableRowCount As Integer
Dim vmCurrentTableColCount As Integer
Dim vmCurrentCellRow As Integer
Dim vmCurrentCellCol As Integer
Dim vmDirection As String
Enum StopCellMode
    FirstLastCell = 0
    FirstBlankCell = 1
End Enum

Public Sub MoveCellsRight()
    If SetModuleVariables("right") Then
        If CheckCurrentCellPosition() Then
            MoveCellContent (FirstLastCell)
        End If
    End If
End Sub

Public Sub MoveCellsLeft()
    If SetModuleVariables("left") Then
        If CheckCurrentCellPosition() Then
            MoveCellContent (FirstLastCell)
        End If
    End If
End Sub

Public Sub MoveCellsRightFirstBlankCell()
    If SetModuleVariables("right") Then
        If CheckCurrentCellPosition() Then
            MoveCellContent (FirstBlankCell)
        End If
    End If
End Sub

Public Sub MoveCellsLeftFirstBlankCell()
    If SetModuleVariables("left") Then
        If CheckCurrentCellPosition() Then
            MoveCellContent (FirstBlankCell)
        End If
    End If
End Sub

Private Function SetModuleVariables(vpDirection As String) As Boolean
    Dim vsOK As Boolean
    Dim vsMsgBoxValue As Integer
    'Check if the [cursor | insertion point] is inside a table.
    If ActiveDocument.ActiveWindow.Selection.Information(wdWithInTable) Then
        vsOK = True
        'Get the index of the current table. / Source: https://wordmvp.com/FAQs/MacrosVBA/GetIndexNoOfPara.htm
        vmCurrentTableIndex = ActiveDocument.Range(0, Selection.Tables(1).Range.End).Tables.Count
        vmCurrentTableRowCount = ActiveDocument.Tables(vmCurrentTableIndex).Rows.Count
        vmCurrentTableColCount = ActiveDocument.Tables(vmCurrentTableIndex).Columns.Count
        vmCurrentCellRow = ActiveDocument.ActiveWindow.Selection.Cells(1).RowIndex
        vmCurrentCellCol = ActiveDocument.ActiveWindow.Selection.Cells(1).ColumnIndex
        vmDirection = vpDirection
    Else
        vsMsgBoxValue = MsgBox("This command can be executed only within a table.", vbInformation, "Error")
        vsOK = False
    End If
    SetModuleVariables = vsOK
End Function

Private Function CheckCurrentCellPosition() As Boolean
    Dim vsOK As Boolean
    Dim vsMsgBoxValue As Integer
    vsOK = True
    If vmDirection = "right" Then
        If vmCurrentCellRow = vmCurrentTableRowCount And vmCurrentCellCol = vmCurrentTableColCount Then
            vsMsgBoxValue = MsgBox("This is the last cell. There is no cell to move to the right.", vbCritical, "Error")
            vsOK = False
        End If
    Else
        If vmCurrentCellRow = 1 And vmCurrentCellCol = 1 Then
            vsMsgBoxValue = MsgBox("This is the first cell. There is no cell to move to the left.", vbCritical, "Error")
             vsOK = False
        End If
    End If
    CheckCurrentCellPosition = vsOK
End Function

Private Sub MoveCellContent(vpStopCellMode As StopCellMode)
    Dim vsCol As Integer
    Dim vsRow As Integer
    Dim vsStartRow As Integer
    Dim vsStartCol As Integer
    Dim vsEndRow As Integer
    Dim vsEndCol As Integer
    Dim vsStep As Integer
    Dim IsStartColSet As Boolean
    Dim vsCurrentCellContent As String
    Dim vsPreviousCellContent As String
    Dim vsLenght As Integer
    vsPreviousCellContent = ""
    IsStartColSet = False
    vsStartRow = vmCurrentCellRow
    vsStartCol = vmCurrentCellCol
    If vmDirection = "right" Then
        vsStep = 1
        vsEndRow = vmCurrentTableRowCount
        vsEndCol = vmCurrentTableColCount
    Else
        vsStep = -1
        vsEndRow = 1
        vsEndCol = 1
    End If
    For vsRow = vsStartRow To vsEndRow Step vsStep
        For vsCol = vsStartCol To vsEndCol Step vsStep
            vsLenght = Len(ActiveDocument.Tables(vmCurrentTableIndex).Cell(vsRow, vsCol).Range.Text) - 2
            vsCurrentCellContent = Left(ActiveDocument.Tables(vmCurrentTableIndex).Cell(vsRow, vsCol).Range.Text, vsLenght)
            ActiveDocument.Tables(vmCurrentTableIndex).Cell(vsRow, vsCol).Range.Text = vsPreviousCellContent
            vsPreviousCellContent = vsCurrentCellContent
            If vsCurrentCellContent = "" And vpStopCellMode = FirstBlankCell Then
                Exit Sub
            End If
        Next
        If IsStartColSet = False Then
            If vmDirection = "right" Then
                vsStartCol = 1
            Else
                vsStartCol = vmCurrentTableColCount
            End If
            IsStartColSet = True
        End If
    Next
End Sub
-1

Попытка ответа:
Напишите макрос для:

  1. создать отдельную копию последней ячейки в таблице под таблицей,
  2. уберите скопированную ячейку из таблицы,
  3. переместите курсор назад к последней оставшейся ячейке, чтобы подготовиться к повторению.

Протестируйте, затем попробуйте удалить интервал границы для выравнивания таблицы
и настроить рендеринг границ, чтобы получить рабочий дизайн / внешний вид.
(Не пробовал это)


Попытка вещей в LibreOffice (v5.1.6.2) Writer, чтобы помочь в записи макроса:

Примечание. Я не пытаюсь записать это в режиме записи, просто покажу, как оно МОЖЕТ работать в Word, при условии, что оно имеет те же привязки клавиш, что и запись. В настоящее время у меня нет доступа к Word. Это пример МЫШЛЕНИЯ, применимого к проблеме. Я не пытаюсь дать конкретный ответ на вопрос.

Меню> Таблица> Вставить таблицу (CTRL+F12), по умолчанию используется таблица 2x2 ...

Введите строки текста по крайней мере в последних двух строках ячеек.

Нажмите курсор вниз, чтобы выйти из таблицы, нажмите ENTER, чтобы между таблицей и любой следующей вставкой была хотя бы одна дополнительная строка.

Теперь приведенное ниже описание может показаться "расширенным", но на практике операции НЕ выполняются.

Запись должна начинаться с того места, где скопирован последний ряд ячеек. Так:

  1. Удерживая клавишу CTRL, дважды нажмите курсор вверх,
    Курсор теперь находится вверху слева от правой ячейки, последняя строка таблицы (начальная точка)
  2. Начать запись (при использовании в Word)
  3. Выберите Меню> Таблица> Разделить таблицу
    (Последняя строка таблицы разделяется на отдельную таблицу)
  4. Теперь держите CTRL и SHIFT, дважды нажмите End
    Записать выделенную целую правую ячейку таблицы из одной строки в два столбца.
  5. Удерживайте CTRL, нажмите X - чтобы вырезать содержимое
  6. Удерживая CTRL+SHIFT, нажмите Home
    Обе ячейки выбраны
  7. Выберите Меню> Таблица> Объединить ячейки
  8. переместить курсор вниз на две строки, вставить (CTRL+V)
  9. Удерживая нажатой клавишу CTRL, перемещайте курсор вверх по одному шагу за раз, пока курсор не будет расположен так, как это было после шага 1) выше.
  10. Остановить запись (при использовании Word).

Последняя строка таблицы была извлечена в две отдельные "таблицы" по одной ячейке в каждой.

Теперь при назначении сочетания клавиш макрокоманде вы будете работать: простейшая вещь - сидеть и держать его, пока макрос "съедает" стол. Вероятно, несколько минут для большого стола, больше, если больше.

Всё ещё ищете ответ? Посмотрите другие вопросы с метками .