[ناجي إبراهيم]

السلام عليكم...

محاولة قد تكون أقصر:

كود :

Private Const ALEFBA = "ابتثجحخدذرزسشصضطظعغفقكلمنهوي"
Private Const ABJADI = "ابجدهوزحطيكلمنسعفصقرشتثخذضطغ"

Private Sub Command1_Click()
    Dim APos As Long
    Dim TxtLen As Long
    Dim Idx As Long
    Dim AChar As String
    
    Text2.Text = ""
    TxtLen = Len(Text1.Text)
    For Idx = 1 To TxtLen
        AChar = Mid$(Text1.Text, Idx, 1)
        APos = InStr(ALEFBA, AChar)
        If APos = 0 Then
            Text2.Text = Text2.Text & AChar
        Else
            Text2.Text = Text2.Text & Mid$(ABJADI, APos, 1)
        End If
    Next Idx
End Sub

نرجو الاستفادة و السلام.