Word VBA: Убрать лишние пробелы в таблицах с помощью макроса

[Anton]

Добрый день! Помогите с этой задачей пожалуйста!
Мне нужно удалить все лишние пробелы в таблице. Т.е. несколько заменить одним, с начала и конца абзаца в ячейке надо вообще удалить пробелы.

[вложение удалено администратором]

[Администратор]

Несколько пробелов заменить одним можно обычным макросом.
Удалить пробел в конце абзаца также можно с помощью обычного макроса: поиск сочетания "знак абзаца + пробел".
Сначала запустите эти макросы.
А затем запустите этот макрос, он удалит концевые пробелы в ячейке.
Макрос работает с выделенной таблицей (или с таблицей, в которой находится курсор).

Макрос

Sub макрос()

    Dim tbl As Table, cell As cell, text As Range, rng As Range
   
    ' Откл. монитора. Может это ускорит макрос.
    Application.ScreenUpdating = False
   
    '1. Присваиваем выделенной таблице имя "tbl", чтобы было удобно писать, а может быть и читать код.
    Set tbl = Selection.Tables(1)
   
    '2. Цикл по всем ячейкам таблицы.
    For Each cell In tbl.Range.Cells
        '1) Удаление впередистоящего пробела.
        If cell.Range.Characters(1).text = " " Then
            cell.Range.Characters(1).Delete
        End If
        '2) Удаление пробела с конца ячейки.
            ' Последний символ в ячейке всегда символ "конец ячейки".
        If cell.Range.Characters.Last.Previous.text = " " Then
            cell.Range.Characters.Last.Previous.Delete
        End If
    Next cell
   
    '3. Сообщение.
    Application.ScreenUpdating = True
    MsgBox "Готово.", vbInformation
   
End Sub

[свернуть]

[Anton]

Протестировал, у меня не работает. У меня word 2010 x32. Не удаляются пробелы в начале и конце ячейки.

[Администратор]

Да, действительно, в Word 2010 метод Range.Delete не работает почему-то (или я пока чего-то не понял).
Используйте такой макрос:

Макрос

Sub макрос()

    Dim tbl As Table, cell As cell
   
    ' Откл. монитора. Может это ускорит макрос.
    Application.ScreenUpdating = False
   
    '1. Присваиваем выделенной таблице имя "tbl", чтобы было удобно писать, а может быть и читать код.
    Set tbl = Selection.Tables(1)
   
    '2. Цикл по всем ячейкам таблицы.
    For Each cell In tbl.Range.Cells
        '1) Удаление впередистоящего пробела.
        If cell.Range.Characters(1).text = " " Then
            cell.Range.Characters(1).text = ""
        End If
        '2) Удаление пробела с конца ячейки.
            ' Последний символ в ячейке всегда символ "конец ячейки".
        If cell.Range.Characters.Last.Previous.text = " " Then
            cell.Range.Characters.Last.Previous.text = ""
        End If
    Next cell
   
    '3. Сообщение.
    Application.ScreenUpdating = True
    MsgBox "Готово.", vbInformation
   
End Sub

[свернуть]

[Anton]

Да, так работает.
Большое спасибо!

[Anton]

А как изменить макрос, чтобы были обработаны все таблицы в документе?

[Администратор]

Макрос

Sub макрос()

    Dim tbl As Table, cell As cell
   
    ' Откл. монитора. Может это ускорит макрос.
    Application.ScreenUpdating = False
   
    ' Цикл по всем таблицам.
    For Each tbl In ActiveDocument.Tables
        ' Цикл по всем ячейкам таблицы.
        For Each cell In tbl.Range.Cells
            '1. Удаление впередистоящего пробела.
            If cell.Range.Characters(1).Text = " " Then
                cell.Range.Characters(1).Text = ""
            End If
            '2. Удаление пробела с конца ячейки.
                ' Последний символ в ячейке всегда символ "конец ячейки".
            If cell.Range.Characters.Last.Previous.Text = " " Then
                cell.Range.Characters.Last.Previous.Text = ""
            End If
        Next cell
    Next tbl
   
    '3. Сообщение.
    Application.ScreenUpdating = True
    MsgBox "Готово.", vbInformation
   
End Sub

[свернуть]

[Anton]

Спасибо!