Зашифровать предложение заменив каждую букву на следующую за ней букву алфавите, сохраняя регистр букв

Private Sub Комманда1_Click()
X = "АБВГДЕЁЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯАабвгдеёжзийклмнопрстуфхцчшщъыьэюяа"
Y = "Наша Маша громко плачет. Уронила в речку мячик"
For i = 1 To Len(Y)
    Z = Z & IIf(InStr(1, X, Mid(Y, i, 1)) > 0, Mid(X, InStr(1, X, Mid(Y, i, 1)) + 1, 1), Mid(Y, i, 1))
Next i
MsgBox Y & vbCrLf & Z, 64, ""
End Sub

Option Explicit
Dim C As String * 1
 
Sub main()
Const r$ = "абвгдеёжзийклмнопрстуфхцчшщъыьэюя"
Const e$ = "abcdefghijklmnopqrstuvwxyz"
Dim i As Long, S As String, O As String
S = InputBox("Введите предложение", , "Зашифровать предложение заменив каждую букву на следующую за ней букву алфавите, сохраняя регистр букв")
For i = 1 To Len(S)
  C = Mid$(S, i, 1)
  Next_C r
  Next_C UCase$(r)
  Next_C e
  Next_C UCase$(e)
  O = O & C
Next i
MsgBox O
End Sub
 
Sub Next_C(S As String)
Dim p As Long
p = InStr(1, S, C, vbBinaryCompare)
If p > 0 Then
  C = Mid$(S, p Mod Len(S) + 1, 1)
End If
End Sub

Option Explicit
Option Compare Text
Private Sub Command1_Click()
    Dim s As String
                  s = InputBox("Введите фразу", , "Наша Маша громко плачет. Уронила в речку мячик")
                  Print s
                  s = Encrypt(s)
                  Print s
                  MsgBox s, 64, ""
End Sub
Function Encrypt(sString As String) As String
    Dim i As Integer, sTemp As String
        For i = 1 To Len(sString)
           Select Case Asc(Mid(sString, i, 1))
                  Case 255: sTemp = sTemp + "а" '224-a 192-А 255-я 223-Я
                  Case 223: sTemp = sTemp + "А"
                  Case 184: sTemp = sTemp + "ж"
                  Case 168: sTemp = sTemp + "Ж" '184-ё 168-Ё 230-ж 198-Ж
                  Case 229: sTemp = sTemp + "ё" '229-е 197-Е
                  Case 197: sTemp = sTemp + "Ё"
                  Case 224 To 255, 192 To 223: sTemp = sTemp + Chr(Asc(Mid(sString, i, 1)) + 1)
                  Case Else: sTemp = sTemp + Mid(sString, i, 1)
           End Select
         Next
    Encrypt = sTemp
End Function