Макрос для получения оригинала

Инструкция, как расшифровать зашифрованные фрагменты текста (внутри таких скобок: //// \\\\) и получить оригинал.

Это то, как я делал, и точно всё работало.

1. Переконвертируйте или перекопируйте книги в простой текст (.txt). С оригинальным вордовским файлом, где оглавление и всё прочее, — у меня не работает.

2. Вставьте или откройте в Ворде.

3. Нажмите Alt + F11. Выйдет редактор макрос-команд.

4. Нажмите Insert > Module

5. В появившееся окно вставьте всю макрос-команду (она ниже).

6. Сверните окно и вернитесь к тексту.

7. Нажмите F8. Выйдет окошко, в котором уже будет нужная макрос-команда.

8. Нажмите "Выполнить". Всё расшифруется. И нажмите "ОК".

9. По желанию напоследок автозаменой (Ctrl + H) замените "////" и "\\\\" на ничто, чтобы убрать эти скобки. Ну и сохраните файл. Можно каждую книгу в отдельный файл опять же, чтобы не было громоздкого файла в итоге, который на смартфонах, например, может зависнуть.

Макрос-команда расшифровки:

---------------------

Sub РасшифроватьФрагменты()

Dim rng As Range

Dim startPos As Long, endPos As Long

Dim fragment As String, result As String

Application.ScreenUpdating = False

Set rng = ActiveDocument.Content

Do

With rng.Find

.Text = "////"

.Forward = True

.Wrap = wdFindStop

If Not .Execute Then Exit Do

End With

startPos = rng.End

rng.SetRange startPos, ActiveDocument.Content.End

With rng.Find

.Text = "\\\\"

.Forward = True

.Wrap = wdFindStop

If Not .Execute Then Exit Do

End With

endPos = rng.Start

rng.SetRange startPos, endPos

If Len(rng.Text) > 0 Then

fragment = rng.Text

result = РасшифроватьЦикл(fragment)

rng.Text = result

End If

rng.SetRange endPos + 4, ActiveDocument.Content.End

Loop While True

Application.ScreenUpdating = True

MsgBox "Расшифровка завершена!", vbInformation

End Sub

Private Function РасшифроватьЦикл(txt As String) As String

Dim alph As String: alph = "абвгдеёжзийклмнопрстуфхцчшщъыьэюя"

Dim i As Integer, pos As Integer, shift As Integer

Dim result As String, ch As String

Dim isUpper As Boolean

result = ""

For i = 1 To Len(txt)

ch = Mid(txt, i, 1)

isUpper = ch Like "[А-ЯЁ]"

If isUpper Then ch = LCase(ch)

pos = InStr(alph, ch)

If pos > 0 Then

Select Case (i Mod 3)

Case 1: shift = 3

Case 2: shift = 2

Case 0: shift = 1

End Select

pos = ((pos - 1 + shift) Mod 33) + 1

ch = Mid(alph, pos, 1)

If isUpper Then ch = UCase(ch)

End If

result = result & ch

Next i

РасшифроватьЦикл = result

End Function

---------------------