VBA Внутри каждого слова перемешать все буквы, кроме первой и последней
Нужен Word-макрос, который по нажатию на кнопку перемешивает внутри каждого слова все буквы, кроме первой и последней
Ответы (1 шт):
Автор решения: deevroman
→ Ссылка
Function shuffleStr(kek As String) As String
If Len(kek) <= 3 Then
shuffleStr = kek
Else
For i = 1 To Len(kek) - 2
Dim a As Integer
Dim b As Integer
a = Int((Len(kek) - 2) * Rnd) + 1
b = Int((Len(kek) - 2) * Rnd) + 1
If b < a Then
Dim tmp As Integer
tmp = b
b = a
a = tmp
End If
If a <> b Then
kek = Left(kek, a) + Mid(kek, b + 1, 1) + Mid(kek, a + 2, b - a - 1) + Mid(kek, a + 1, 1) + Right(kek, Len(kek) - b - 1)
End If
Next i
shuffleStr = kek
End If
End Function
Private Sub CommandButton_Click()
Application.ScreenUpdating = False
Dim wrdFind As Find
Dim wrdRng As Range
Set wrdRng = Application.ActiveDocument.Content
Set wrdFind = wrdRng.Find
With wrdFind
.Text = "<[а-яА-ЯёЁa-zA-Z]*>"
.MatchWildcards = True
End With
Dim objUndo As UndoRecord
Set objUndo = Application.UndoRecord
objUndo.StartCustomRecord ("Undo Shuffler")
Do While wrdFind.Execute = True
wrdRng.Text = shuffleStr(wrdRng.Text)
Loop
objUndo.EndCustomRecord
Application.ScreenUpdating = True
End Sub