Здравствуйте, проблема в следующем, после использования данного макроса (нужно выделить необходимую часть текста для обработки и принять значение 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
Слова начинают переноситься на новую строку, пример прикрепил во вложении. Возможно ли запретить этот перенос, чтобы слова оставались на своей строке, заранее спасибо!
Я так понимаю, что обычные пробелы заменяются на неразрывные, поэтому текст становится сплошным, а переносить его надо ведь на следующую строку, даже если пробелов нет, вот Ворд и разбивает по своему усмотрению.
Значит нужно где-то ставить обычный пробел.
Не смогу помочь по этой теме, для меня это сложно.
Добрый день. Можно ведь заменить
Что можно заменить?
просто найти неразрывный пробел и заменить на обычный
Не понял вас, напишите словами, а не используя код.
Да, спасибо, разобрался с проблемой.