5.Макрос Перекодирование текста о финансовых отчётах предприятия из ос dos в Windows.

Attribute VB_Name = "Перекодировка"

Option Explicit

Public Sub ИзDOSвWindows()

Dim ff$, k%, i%, n%

On Error GoTo Ошибка

ff = ""

With Selection

k = Len(.Text)

If .Start = .End Then

MsgBox "Нет текста для перекодировки", vbOKOnly + vbExclamation, "DOS => Windows"

Else

For i = 1 To k

n = Asc(Mid(.Text, i, 1))

If n > 127 And n < 176 Then

n = n + 64

ElseIf n > 223 And n < 240 Then

n = n + 16

ElseIf n = 241 Then 'ё

n = 184

End If

ff = ff & Chr(n)

Next i

.Delete

.InsertAfter ff

End If

End With

Exit Sub

Ошибка:

On Error GoTo 0

MsgBox "Документ отсутствует", vbCritical, "Работу прекращаем"

End Sub

Public Sub ИзWindowsвDOS()

Dim ff$, k%, i%, n%

On Error GoTo Ошибка

ff = ""

With Selection

k = Len(.Text)

If .Start = .End Then

MsgBox "Нет текста для перекодировки", vbOKOnly + vbExclamation, "DOS => Windows"

Else

For i = 1 To k

n = Asc(Mid(.Text, i, 1))

If n > 191 And n < 240 Then

n = n - 64

ElseIf n > 239 And n < 256 Then

n = n - 16

End If

ff = ff & Chr(n)

Next i

.Delete

.InsertAfter ff

End If

End With

Exit Sub

Ошибка:

On Error GoTo 0

MsgBox "Документ отсутствует", vbCritical, "Работу прекращаем"

End Sub

Public Sub ИзТекстаВрусс()

Dim ff$, k%, i%, j%, n%, min%, max%

ff = "": min = 256

With Selection

k = Len(.Text)

If .Start = .End Then

MsgBox "Нет текста для перекодировки", vbOKOnly + vbExclamation, "DOS => Windows"

Else

For i = 1 To k 'определение минимального кода

n = Asc(Mid(.Text, i, 1))

min = (n + min - Abs(n - min)) / 2

max = (n + max + Abs(n - max)) / 2

Next i

For j = 192 To 255

If j + max - min > 255 Then Exit For

ff = ff & Format(j - 191) & ". "

For i = 1 To k

ff = ff & Chr(Asc(Mid(.Text, i, 1)) - min + j)

Next i

If j < 255 Then ff = ff & vbCrLf

Next j

If ff = "" Then

Beep

Else

Documents.Add Template:="Normal", NewTemplate:=False

.InsertAfter ff

End If

End If

End With

End Sub

25