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

[AZaharov]

приветствую вновь!

кто поможет написать скрипт для ворда. думаю, это совсем не сложно для знающего человека. смысл такой: в исходный текст между буквами нужно вставить пробелы размером "1". если между словами уже имеется пробел, то трогать его не нужно

пример и то, как должно выглядеть:



разницы почти не видно, но она есть и чертовские важна. кто поможет?

[EducatedFool]

Пробел какой? Обычный, или неразрывный?

Обязательно пробелы, или можно просто увеличить интервал между символами?

Добавлять только между буквами? (до и после знаков препинания не надо?)

Скрипт должен обрабатывать один файл, или несколько?

разницы почти не видно, но она есть и чертовские важна

Чтобы поиск не находил этот текст?

[AZaharov]

не знаю точно, в чем разница между указанными тобой пробелами, но ставить лучше, тот же, что и с клавиатуры

да, обязательно пробелы

да, только между буквами. знаки препинания обрабатывать не нужно

да, обработке подлежит только один файл. если будет необходимо больше, копипастну текст. это не критично

Чтобы поиск не находил этот текст?

верно!

[viter.alex]

Предложенный макрос разбивает пробелами все слова в тексте всего документа. Попробуйте, если нужно, переделать его под разбивку слов только в выделенном тексте.

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

Одно маленькое замечание: если текст выровнен по ширине, то пробелы внутри слова могут растягиваться. Чтобы этого не было, можно между символами вставлять не обычные пробелы, а неразрывные. Тогда и слово распадаться на части не будет, если вдруг попадет в зону переноса.

И еще одно маленькое замечание: Зачем нужно, чтобы этот текст не находил поиск?

И еще одно: Программы на языке VBA называются макросами.

[AZaharov]

макрос работает, но ворд вешается при больших объемах, хотя мой пк имеет 4гб памяти. удачно удалось обработать только 2страничный файл.

возможно ли изменить его так, чтобы пробелы он вставлял в слова в зависимости от их длины? например, если количество букв меньше, либо рано восьми - один пробел. больше - два пробела. я думаю, это должно ускорить процесс, а результат будет практически стопроцентно идентичным. то есть из каких слов состоит текст определить будет невозможно (для компьютера) без предварительной правки

[viter.alex]

Код, который делает то, что вы попросили, ниже. Изменение выделено красным пунктиром. Ненужная часть кода закомментирована

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 'Найденная часть документа
'----------------------------------------------------
        If Len(oRng.Text) <= 8 And Len(oRng.Text) > 1 Then
          oRng.Characters(oRng.Characters.Count \ 2).InsertAfter " "
        ElseIf Len(oRng.Text) > 8 Then
          oRng.Characters(oRng.Characters.Count \ 3).InsertAfter " "
          oRng.Characters(oRng.Characters.Count * 2 \ 3).InsertAfter " "
        End If
'----------------------------------------------------
        'Перед каждым символом в слове, кроме первого, вставляем пробел
'        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

А то, что Word вешается, так это естественно. Макросы быстродействием никогда не отличались. Они же компилируются на ходу.

Добавлено позже
Я тут подумал, что если нужно будет проделать обратную операцию — убрать пробелы, то для этого и макрос не нужен. Все можно делать через стандартные Поиск и Замену (Ctrl+H):
Найти: (пробел) и Формат→ Шрифт поставить размер 1пт
Заменить: оставить пустым.
Нажать «Заменить все».

[AZaharov]

отличный результат! 10страничный документ отпарсился за 3-4 минуты с подвисанием vba-редактора. ежели количество времени, необходимое для обработки документа, увеличивается пропорционально количеству страниц в документе, то на этом все. премного благодарен

ELSE буду держать в курсе событий, как говориться

[viter.alex]

Время обработки будет увеличиваться пропорционально количеству слов в тексте.
Но, хоть убейте, не пойму зачем это делать! Что за секретность такая?
Интересно, а программы оптического распознавания такой текст «возьмут»?

[viter.alex]

Придумался еще один вариант. Быстрее, как мне кажется.

1. С помощью поиска и замены вставляем между двумя буквами какой-нибудь набор символов, например такой #$&@. Главное, чтобы оно в тексте больше нигде не встречалось. Для этого нужно включить подстановочные знаки и ввести такие параметры:
   Найти: ([A-Za-zА-Яа-яЁё])([A-Za-zА-Яа-яЁё])
   Заменить на: \1#$&@\2
2. Затем выключить подстановочные знаки, и заменить этот набор символов на пробел размером 1 пт:
   Найти: #$&@
   Заменить на: (пробел). Формат→Шрифт: 1 пт.

Вот и все. Результат достигнут — текст не поддается поиску.
То же самое можно сделать и макросом:

Sub AntiPlagiat()
  With ActiveDocument.Range.Find
    .Text = "([A-Za-zА-Яа-яЁё])([A-Za-zА-Яа-яЁё])": .MatchWildcards = True
    .Replacement.Text = "\1#$&@\2"
    .Execute Replace:=wdReplaceAll
    .Text = "#$&@": .MatchWildcards = False
    .Replacement.Text = " ": .Replacement.Font.Size = 1
    .Execute Replace:=wdReplaceAll
  End With
End Sub

Вот так-то!

[sam00]

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