Автор Тема: Word VBA: Убрать лишние пробелы в таблицах с помощью макроса  (Прочитано 2207 раз)

Anton

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

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

Оффлайн Администратор

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

Макрос
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. Не удаляются пробелы в начале и конце ячейки.

Оффлайн Администратор

  • Administrator
  • Сообщений: 2162
Да, действительно, в 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

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

Оффлайн Администратор

  • Administrator
  • Сообщений: 2162
Макрос
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

  • Гость