Como deslocar células para um lugar em uma tabela no Microsoft Word 2013 após remover/inserir?

Question

Se eu tiver uma tabela como esta:

A B
C D
E F

Quando removo a célula B, quero que todas as células se desloquem em direção a A assim:

A C
D E
F

Como conseguir isso? Além disso, como conseguir o oposto - inserir uma única célula em algum lugar e fazer com que todas as outras células se movam para um lugar?

Answer 1

Há alguns dias precisei de algo parecido com o que Knezmilos pediu e não encontrei nada para fazer. Então, criei uma macro VBA (Word 2016) para fazer exatamente isso. A macro funciona de quatro maneiras diferentes:

1. Desloque todas as células para a direita até o final da tabela (Public Sub MoveCellsRight)
2. Desloque todas as células para a direita até a primeira célula em branco (Public Sub MoveCellsRightFirstBlankCell)
3. Desloque todas as células para a esquerda até o início da tabela (Public Sub MoveCellsLeft)
4. Desloque todas as células para a esquerda até a primeira célula em branco (Public Sub MoveCellsLeftFirstBlankCell)

Esta macroNÃO VOU:

1. Trabalhe com tabelas dentro de uma célula.
2. Trabalhe com células divididas (cada linha deve ter o mesmo número de colunas).
3. Preservar o formato da célula. (Espero que alguém melhore esta macro adicionando este recurso).

Aqui está a macro:

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

Answer 2

Tentativa de resposta:
Escreva uma macro para:

1. crie uma cópia separada da última célula da tabela abaixo da tabela,
2. remova a célula copiada da tabela,
3. mova o cursor para a última célula restante para se preparar para uma repetição.

Teste e tente remover o espaçamento das bordas para o interalinhamento da tabela
e ajuste a renderização das bordas para obter um design/aparência funcional.
(Não tentei isso)

---

Tentando coisas no LibreOffice (v5.1.6.2) Writer, para ajudar na gravação da macro:

Nota: não estou tentando registrar isso no Write, apenas mostro como PODE funcionar no Word, assumindo que tenha as mesmas combinações de teclas do Write. Não tenho acesso ao Word no momento Este é um exemplo do PENSAMENTO a ser aplicado ao problema, não estou tentando uma resposta específica para a Q

Menu > Tabela > Inserir Tabela (CTRL+F12), o padrão é tabela 2x2...

Digite linhas de texto pelo menos nas duas últimas linhas de células.

Pressione o cursor para baixo para sair da tabela, pressione ENTER para ter pelo menos uma linha extra entre a tabela e qualquer colagem futura.

Agora, a descrição abaixo pode parecer "avançada" - mas as operações na prática NÃO são.

A gravação deve começar onde a última linha de células foi copiada. Então:

1. Segure CTRL, pressione o cursor para cima duas vezes,
   o cursor agora está no canto superior esquerdo da célula direita, última linha da tabela (o ponto inicial)
2. Comece a gravar (ao usar no Word)
3. Selecione Menu > Tabela > Dividir tabela
   (a última linha da tabela é dividida em uma tabela separada)
4. Agora segure CTRL e SHIFT, pressione End duas vezes.
   Escreva selecionada toda a célula do lado direito da tabela de linha única e duas colunas.
5. Segure CTRL, aperte X - para cortar o conteúdo
6. Segure CTRL + SHIFT, pressione Home
   Ambas as células selecionadas
7. Selecione Menu > Tabela > Mesclar Células
8. mova o cursor duas linhas para baixo, cole (CTRL+V)
9. Mantenha pressionada a tecla CTRL e mova o cursor para cima um passo de cada vez até que o cursor seja posicionado de forma semelhante ao passo 1) acima.
10. Pare de gravar (ao usar o Word).

A última linha da tabela foi extraída em duas “tabelas” separadas com uma célula cada.

Agora, atribuir uma tecla de atalho à macro fará com que você execute: O simples aqui é sentar e segurar enquanto a macro "devora" a mesa. Provavelmente alguns minutos para uma mesa grande, mais tempo se for maior.