1

Тема: Вставить мягкий перенос в каждое третье слово

Помогите пожалуйста! Нужен макрос Word для вставки мягкого переноса в каждое третье слово текста. Причем желательно чтобы перенос в слове был только один (неважно после какого слога).
Или подскажите пожалуйста, что исправить в этом макросе?
Перенос встаялется ВМЕСТО каждого третьего слова а нужно чтобы перенос вставлялся в КАЖДОЕ третье слово.


Sub ChangeEveryThirdWord()
  Dim i As Long 'Счётчик слов
  Dim oWord As Range 'Текущее слово
  
  'Инициализация переменных
  Set oWord = ActiveDocument.Words.First
  i = 1
  'Перебираем все слова в документе, отсеивая знаки препинания и знаки абзацев.
  Do While i <= ActiveDocument.Words.Count
    
      While Trim(oWord.Text) Like "[.,!?""-]" Or oWord.Text = vbCr
      If oWord.End = ActiveDocument.Words.Last.End Then Exit Sub
      Set oWord = oWord.Next(wdWord)
    Wend
    
    'Если значение счётчика кратно пяти, то изменяем слово
    If i Mod 3 = 0 Then
    oWord.MoveEndWhile " ", wdBackward 'Убираем пробел в конце слова
    Options.AutoFormatAsYouTypeReplaceQuotes = False
    oWord = Chr(31)
    Selection.Find.Execute Replace:=wdReplaceAll
    oWord.HighlightColorIndex = wdYellow 'Подсвечиваем жёлтым
    End If
    
    i = i + 1
    Set oWord = oWord.Next(wdWord)
    If oWord.End = ActiveDocument.Words.Last.End Then Exit Sub
    DoEvents
    
  Loop
End Sub

2

Re: Вставить мягкий перенос в каждое третье слово

В этом примере я выделил третье слово и вставил в него ручной перенос :

Sub Макрос1()
'
    Selection.MoveRight Unit:=wdWord, Count:=2
    Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend
    ActiveDocument.ManualHyphenation
End Sub

Так подойдет?

Удобной и приятной работы в Word!
Перевести спасибо на Яндекс кошелёк - 41001162202962; на WebMoney - R581830807057.

3

Re: Вставить мягкий перенос в каждое третье слово

Такой вариант не подходит. Нужно чтобы перенос вставлялся в КАЖДОЕ третье слово текста автоматически. Причем желательно чтобы перенос в слове был только один (неважно после какого слога).

4

Re: Вставить мягкий перенос в каждое третье слово

Эту задачу я решил по вашему же запросу на киберфоруме. Копирую ответ сюда

Option Explicit
 
Public Type HyphenPair
    Pattern As String
    Position As Integer
End Type
 
Dim arHPairs(12) As HyphenPair
Private Const x As String = "йьъ"
Private Const g As String = "аеёиоуыэюяaeiouy"
Private Const s As String = "бвгджзклмнпрстфхцчшщbcdfghjklmnpqrstvwxz"
 
Sub HyphenateEveryThirdWord()
    Dim arHyphPos As Variant
    Dim oRng As Range, nHyphPos As Integer
    Dim sText As String
   On Error GoTo HyphenateEveryThirdWord_Error
 
    Set oRng = ActiveDocument.Words.First
    Dim i As Integer
    i = 1
    
    Do Until oRng Is Nothing
        If Len(Trim(oRng.text)) > 0 Then
            arHyphPos = HyphenPositions(Trim(oRng.text))
            Randomize
            'Случайная позиция вставки переноса
            nHyphPos = Int((UBound(arHyphPos) - 1) * Rnd)
            nHyphPos = arHyphPos(nHyphPos)
            oRng.text = Mid(oRng.text, 1, nHyphPos) & ChrW(31) & Mid(oRng.text, nHyphPos + 1)
            i = i + 3
            
            Set oRng = ActiveDocument.Words(i)
            DoEvents
        End If
    Loop
 
    On Error GoTo 0
    Exit Sub
 
HyphenateEveryThirdWord_Error:
 
End Sub
 
'Номера символов после которых можно вставить переносы
Public Function HyphenPositions(text As String) As Variant
    Dim i As Integer, j As Integer
    Dim sb As String, sText As String
    Dim retval As String
    sText = StrConv(text, vbLowerCase)
    Call Main
    For i = 1 To Len(sText)
        If InStr(x, Mid(sText, i, 1)) <> 0 Then
            sb = sb & "x"
        ElseIf InStr(g, Mid(sText, i, 1)) <> 0 Then
            sb = sb & "g"
        ElseIf InStr(s, Mid(sText, i, 1)) <> 0 Then
            sb = sb & "s"
        End If
    Next
    Dim hp As HyphenPair, index As Integer, actualindex As Integer
    For i = 0 To UBound(arHPairs)
        hp = arHPairs(i)
        index = InStr(sb, hp.Pattern)
        While (index <> 0)
            actualindex = index + hp.Position
            retval = retval & actualindex - 1 - j & ","
            sb = Mid(sb, 1, actualindex - 1) & "-" & Mid(sb, actualindex)
            index = InStr(sb, hp.Pattern)
            j = j + 1 'Счётчик вставленных переносов
        Wend
    Next i
    retval = Mid(retval, 1, Len(retval) - 1)
   HyphenPositions = Split(retval, ",")
End Function
 
Sub Main()
    Dim hp As HyphenPair
    arHPairs(0).Pattern = "xgg": arHPairs(0).Position = 1
    arHPairs(1).Pattern = "xgs": arHPairs(1).Position = 1
    arHPairs(2).Pattern = "xsg": arHPairs(2).Position = 1
    arHPairs(3).Pattern = "xss": arHPairs(3).Position = 1
    arHPairs(4).Pattern = "gsg": arHPairs(4).Position = 1
    arHPairs(5).Pattern = "sgg": arHPairs(5).Position = 2
    arHPairs(6).Pattern = "gssssg": arHPairs(6).Position = 3
    arHPairs(7).Pattern = "gsssg": arHPairs(7).Position = 3
    arHPairs(8).Pattern = "gsssg": arHPairs(8).Position = 2
    arHPairs(9).Pattern = "gssg": arHPairs(9).Position = 2
    arHPairs(10).Pattern = "sgsg": arHPairs(10).Position = 2
    arHPairs(11).Pattern = "sggg": arHPairs(11).Position = 2
    arHPairs(12).Pattern = "sggs": arHPairs(12).Position = 2
End Sub

Вызывать процедуру HyphenateEveryThirdWord. Неочевидно, но разбивка на слоги и расстановка переносов — не совсем одно и то же. Предложенный макрос работает корректно с подавляющим большинством слов. Более совершенный реализовать средствами ВБА не получится в силу сложности

Лучше день потерять — потом за пять минут долететь!

5

Re: Вставить мягкий перенос в каждое третье слово

Благодарю, но как использовать этот макрос?
Я добавил вначале макроса запись:
Sub Макрос1()
'
' Макрос1 Макрос
'
'
Option Explicit

Public Type HyphenPair
    Pattern As String
    Position As Integer
End Type
.......................................................
............................................ дальше тело макроса
End Sub

Но макрос не работает, первая строка подчеркивается желтым и выдается сообщение об ошибке: Compile error: Invalid inside procedure

6

Re: Вставить мягкий перенос в каждое третье слово

Ничего добавлять не нужно, используйте так как есть. Вставьте весь код в модуль, перейдите в документ, нажмите Alt+F8 и выберите процедуру HyphenateEveryThirdWord

Лучше день потерять — потом за пять минут долететь!

7

Re: Вставить мягкий перенос в каждое третье слово

Сделал все как указано, но после выполнения макроса ничего не происходит. Если включить опцию отобразить все знаки, видно, что  вставляется только один перенос в самое первое слово текста