Автор Тема: Перенос слов после использования макроса  (Прочитано 193 раз)

Оффлайн Monocle

  • Посетитель форума
  • Сообщений: 15
Здравствуйте, проблема в следующем, после использования данного макроса (нужно выделить необходимую часть текста для обработки и принять значение 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
   
Слова начинают переноситься на новую строку, пример прикрепил во вложении. Возможно ли запретить этот перенос, чтобы слова оставались на своей строке, заранее спасибо!

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

  • Administrator
  • Сообщений: 2162
Я так понимаю, что обычные пробелы заменяются на неразрывные, поэтому текст становится сплошным, а переносить его надо ведь на следующую строку, даже если пробелов нет, вот Ворд и разбивает по своему усмотрению.
Значит нужно где-то ставить обычный пробел.
Не смогу помочь по этой теме, для меня это сложно.

Оффлайн Посетитель 29.10.2022

  • Посетитель форума
  • Сообщений: 12
Добрый день. Можно ведь заменить

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

  • Administrator
  • Сообщений: 2162
Что можно заменить?

Оффлайн Посетитель 29.10.2022

  • Посетитель форума
  • Сообщений: 12
просто найти неразрывный пробел и заменить на обычный

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

  • Administrator
  • Сообщений: 2162
Не понял вас, напишите словами, а не используя код.

Оффлайн Monocle

  • Посетитель форума
  • Сообщений: 15
Да, спасибо, разобрался с проблемой.