vba скрипт для ворда

[sam00]

Sub DivideLettersBySpaces()
  Dim oRng As Range, i&, IsEnd As Boolean
  Dim iStart& 'Переменная для ограничения нижней границы поиска
  Do While Not IsEnd 'Продолжаем поиск пока флаг установлен
    With ActiveDocument.Range(iStart, ActiveDocument.Range.End).Find
      'Ищем слово, которое может состоять только из латинских или кириллических букв
      .Text = "<[A-za-zА-ЯЁа-яё]@>"
      .MatchWildcards = True
      .Execute
      If .Found Then 'слово найдено
        Set oRng = .Parent
        'Перед каждым символом в слове, кроме первого, вставляем пробел
        For i = oRng.Characters.Count To 2 Step -1
          oRng.Characters(i).InsertBefore " "
        Next
        'Нижнюю границу поиска переносим в конец слова уже с учетом добавленных пробелов
        iStart = oRng.End
        'В слове, разделенном пробелами делаем величину шрифта для пробелов равной 1
        With oRng.Find
          .Text = " "
          .Replacement.Font.Size = 1
          .Execute Replace:=wdReplaceAll
        End With
      Else: IsEnd = True 'Если слово не было найдено, выходим из цикла
      End If
    End With
  Loop
End Sub

А можно ли такое же, но чтобы текст обрабатывался лишь в одной ячейке в Excel? Например, для А1...

[viter.alex]

А при чём здесь Excel? А вообще, можно. Если не заморачиваться с пробелами и знаками препинания, то вот так:

Sub test()
  Dim s As String, s1 As String
  Dim i As Integer
  
  s = [a1].Value
  For i = 1 To Len(s)
    s1 = s1 & Mid(s, i, 1) & " "
  Next
  [a1].Value = s1
End Sub

[sam00]

Благодарю, именно такое и нужно

[Вождь]

Вместо пробелов проще использовать спецсимволы нулевой длины. Таких символов в наборе Unicode предостаточно. Минус в том, что не все шрифты их поддерживают. Например, ChrW(&H200B) - неразрывный пробел нулевой длины, или другие из интервала &H200C-&H200F.
В MS Word вся операция сводится к одной замене:

    With ActiveDocument.Range
        .Collapse
        With .Find
            .ClearFormatting
            .Replacement.ClearFormatting
            .Wrap = wdFindContinue
            .MatchWildcards = True
            .Text = "([A-Za-zА-ЯЁа-яё])([A-Za-zА-ЯЁа-яё])"
            .Replacement.Text = "\1" & ChrW$(&H200E) & "\2"
            .Execute Replace:=Word.wdReplaceAll
            End With
    End With

[garik64]

Вообще не понимаю, зачем тут макрос. Найти "([А-Яа-я])([А-Яа-я])" с подстановочными знаками, заменить на "\1 \2" и прогнать эту операцию два раза.

[viter.alex]

Сообщение от garik64

Вообще не понимаю, зачем тут макрос. Найти "([А-Яа-я])([А-Яа-я])" с подстановочными знаками, заменить на "\1 \2" и прогнать эту операцию два раза.

Затем, что пробел должен быть не того же кегля, что и текст, а 1 пт

[garik64]

Сообщение от viter.alex

Затем, что пробел должен быть не того же кегля, что и текст, а 1 пт

Бог ты мой! На одну операцию больше. "([А-Яа-я])([А-Яа-я])" менять на \1#\2, а потом # на "пробел, 1 пт".

[viter.alex]

Не то ли самое я предложил с самого начала?

[garik64]

Сообщение от viter.alex

Не то ли самое я предложил с самого начала?

Упс! Действительно, проглядел. Прошу пардону.

[julle]

Подскажите, как можно сделать так, что бы при обработке макросом ворд не подчеркивал красным?