Автор Тема: Word VBA Макросы: Как удалить первые и последние пробелы в ячейках таблиц?  (Прочитано 828 раз)

Оффлайн Rengame113

  • Посетитель форума
  • Сообщений: 97
Как удалить пробелы в начале и в конце в каждой ячейке в таблицах Word?

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

  • Administrator
  • Сообщений: 1939
Макрос
Sub Макрос()

    Dim табл As Table, яч As Cell
   
   
    ' Отключение монитора (может это ускорит макрос).
    Application.ScreenUpdating = False
   
    ' Движение по всем таблицам.
    For Each табл In ActiveDocument.Tables
        ' Движение по всем ячейкам таблицы.
        For Each яч In табл.Range.Cells
            ' Удаление пробелов.
            УдалитьПередниеПробелы яч.Range
            УдалитьЗаданиеПробелы яч.Range
        Next яч
    Next табл
   
    ' Включение монитора.
    Application.ScreenUpdating = True
   
    ' Сообщение.
    MsgBox "Готово.", vbInformation

End Sub

Private Sub УдалитьПередниеПробелы(яч As Range)

    ' Процедура удаляет передние пробелы.
        ' MoveEndWhile не используется, т.к. он видит пробелы, которые
        ' находятся внутри поля (например, внутри гиперссылки).
   
    Dim rng As Range, счётчик As Long
    Dim i As Long


    '1. Подсчёт пробелов, которые находятся в начале ячейки.
        ' Последний символ - это кружок, поэтому он не анализируется.
    For i = 1 To яч.Characters.Count - 1
        If яч.Characters(i).Text = " " Then
            счётчик = счётчик + 1
        Else
            Exit For
        End If
    Next i
   
    '2. Если нет пробелов.
    If счётчик = 0 Then
        Exit Sub
    End If
   
    '3. Удаление пробелов.
    Set rng = яч.Duplicate
    rng.Collapse Direction:=wdCollapseStart
    rng.MoveEnd Unit:=wdCharacter, Count:=счётчик
    rng.Text = ""

End Sub

Private Sub УдалитьЗаданиеПробелы(яч As Range)

    ' Процедура удаляет задние пробелы.
        ' MoveStartWhile не используются, т.к. он видит пробелы, которые
        ' находятся внутри поля (например, внутри гиперссылки).
   
    Dim rng As Range, счётчик As Long
    Dim i As Long

   
    '1. Подсчёт пробелов, которые находятся в конце ячейки.
        ' Последний символ - это кружок, поэтому он не анализируется.
    For i = яч.Characters.Count - 1 To 1 Step -1
        If яч.Characters(i).Text = " " Then
            счётчик = счётчик + 1
        Else
            Exit For
        End If
    Next i
   
    '2. Если нет пробелов.
    If счётчик = 0 Then
        Exit Sub
    End If
   
    '3. Удаление пробелов.
    Set rng = яч.Duplicate
    rng.Collapse Direction:=wdCollapseEnd
    rng.Move Unit:=wdCharacter, Count:=-1
    rng.MoveStart Unit:=wdCharacter, Count:=-счётчик
    rng.Text = ""

End Sub

Оффлайн Rengame113

  • Посетитель форума
  • Сообщений: 97
Спасибо, все работает.