Форум по VBA, Excel и Word

Word => Макросы в Word => Тема начата: Monocle от 22 Ноябрь 2022, 10:25

Название: Перенос слов после использования макроса
Отправлено: Monocle от 22 Ноябрь 2022, 10:25
Здравствуйте, проблема в следующем, после использования данного макроса (нужно выделить необходимую часть текста для обработки и принять значение 1 в диалоговом окне): 

Option Explicit

Sub test()
   
Dim x As Integer, i As Integer, j As Integer, a As Integer, spase As Integer, k As Integer
Dim fsize As String, ffont As String, fnd As String, rpl As String
Dim RR As Object, t As Single, oldStatusBar As Boolean
   
   
Set RR = CreateObject("VBScript.RegExp")
    spase = InputBox("Укажити какой каждый по счету заменять пробел:", "test", 1)
    t = Timer
   
    With RR
        .Global = True
        .Pattern = "[A-Za-zА-Яа-яЁё]+"
        ReDim ARR(.Execute(Selection).Count) As String
        For i = 0 To .Execute(Selection).Count - 1
            ARR(i) = Chr(160) & .Execute(Selection).Item(i) & Chr(160)
        Next i
        x = .Execute(Selection).Count - 1
    End With
     
    If i = 0 Then
        MsgBox "Выдели текст для обработки!", vbCritical + vbOKOnly, "test"
        Exit Sub
    End If

   
    oldStatusBar = Application.DisplayStatusBar
    Application.ScreenUpdating = False
    ActiveDocument.Windows(1).View.Type = wdNormalView
    Application.Options.CheckGrammarAsYouType = False
    Application.Options.CheckGrammarWithSpelling = False
    Application.Options.ContextualSpeller = False
    Application.Options.CheckSpellingAsYouType = False
    Application.Options.ShowReadabilityStatistics = False
    ActiveDocument.ShowGrammaticalErrors = False
    ActiveDocument.ShowSpellingErrors = False

   
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
   
    fnd = Chr(32)
    rpl = Chr(160)
    fsize = Selection.Font.Size
    ffont = Selection.Font.Name

   
    For j = 1 To x - 1
        a = Int((x + 1) * Rnd)

        With Selection
            .Find.text = fnd
            .Find.Replacement.text = (ARR(a))
            .Find.Forward = True
            .Find.Wrap = wdFindStop
            .Find.Format = True
            .Find.Replacement.Font.Name = "___WRD_EMBED_SUB_43"
            .Find.Replacement.Font.ColorIndex = 1
            .Find.Replacement.Font.Size = 12
            .Find.Replacement.text = StrConv(.Find.Replacement.text, 2)
            .Collapse Direction:=wdCollapseStart
            .Find.Execute Replace:=wdReplaceOne
            .Collapse Direction:=wdCollapseEnd
           
            If spase = 1 Then spase = spase + 1
            For k = 1 To spase - 1
                .Find.Execute
            Next k
           
        End With
       
    Next j

        With Selection
            .Find.text = rpl
            .Find.Replacement.text = rpl
            .Find.Forward = True
            .Find.Wrap = wdFindContinue
            .Find.Format = True
            .Find.Replacement.Font.Name = ffont
            .Find.Replacement.Font.ColorIndex = 1
            .Find.Replacement.Font.Size = fsize / 2
            .Find.Execute Replace:=wdReplaceAll
        End With
    t = Timer - t
    MsgBox "Завершено за: " & t & " сек.! Добавлено " & x - 1 & " слов(а).", vbInformation + vbOKOnly, "test"

    Application.ScreenUpdating = False
    ActiveDocument.Windows(1).View.Type = wdPrintView
    Application.Options.CheckGrammarAsYouType = False
    Application.Options.CheckGrammarWithSpelling = False
    Application.Options.ContextualSpeller = False
    Application.Options.CheckSpellingAsYouType = False
    Application.Options.ShowReadabilityStatistics = False
    ActiveDocument.ShowGrammaticalErrors = False
    ActiveDocument.ShowSpellingErrors = False


End Sub
   
Слова начинают переноситься на новую строку, пример прикрепил во вложении. Возможно ли запретить этот перенос, чтобы слова оставались на своей строке, заранее спасибо!
Название: Re: Перенос слов после использования макроса
Отправлено: Администратор от 22 Ноябрь 2022, 10:59
Я так понимаю, что обычные пробелы заменяются на неразрывные, поэтому текст становится сплошным, а переносить его надо ведь на следующую строку, даже если пробелов нет, вот Ворд и разбивает по своему усмотрению.
Значит нужно где-то ставить обычный пробел.
Не смогу помочь по этой теме, для меня это сложно.
Название: Re: Перенос слов после использования макроса
Отправлено: Посетитель 29.10.2022 от 29 Ноябрь 2022, 17:13
Добрый день. Можно ведь заменить
Название: Re: Перенос слов после использования макроса
Отправлено: Администратор от 29 Ноябрь 2022, 17:15
Что можно заменить?
Название: Re: Перенос слов после использования макроса
Отправлено: Посетитель 29.10.2022 от 29 Ноябрь 2022, 17:26
просто найти неразрывный пробел и заменить на обычный
Название: Re: Перенос слов после использования макроса
Отправлено: Администратор от 29 Ноябрь 2022, 17:33
Не понял вас, напишите словами, а не используя код.
Название: Re: Перенос слов после использования макроса
Отправлено: Monocle от 29 Ноябрь 2022, 17:38
Да, спасибо, разобрался с проблемой.