Module Module1

    Public Const abjadString As String _
        = "ابجدهوزحطیکلمنسعفصقرشتثخذضظغ"
    Enum abjadType
        vasit
        saghir
        kabir
    End Enum

    Public Function matchChars(chr As Char) As Char
        Select Case chr
            Case "آ", "أ"
                Return "ا"
            Case "گ", "ك"
                Return "ک"
            Case "چ"
                Return "ج"
            Case "پ"
                Return "ب"
            Case "ژ"
                Return "ز"
            Case "ي", "ئ"
                Return "ی"
            Case "ؤ"
                Return "و"
            Case "ة"
                Return "ت"
            Case "ء"
                Return vbNullChar
            Case Else
                Return chr
        End Select

    End Function

    Public Function getVasitCharCode(ByVal chr As Char) As Integer
        chr = Trim(matchChars(chr))
        If chr = vbNullString Then Return 0
        Return abjadString.IndexOf(chr) + 1
    End Function

    Public Function getKabirCharCode(ByVal chr As Char) As Integer
        chr = Trim(matchChars(chr))
        If chr = vbNullChar Then Return 0
        Dim charLocation = abjadString.IndexOf(chr) + 1
        Select Case charLocation
            Case Is <= 10
                Return charLocation
            Case Is < 20
                Return (charLocation - 9) * 10
            Case Else
                Return (charLocation - 18) * 100
        End Select
    End Function

    Private Function getSaghirCharCode(chr As Char) As Integer
        chr = Trim(matchChars(chr))
        If chr = vbNullChar Then Return 0
        Dim charLocation = abjadString.IndexOf(chr) + 1
        Dim tmp = charLocation Mod 9
        If tmp = 0 Then tmp = 9
        Return tmp
    End Function

    Public Function getAbjadCode(ByVal str As String, abjadType As abjadType) As Integer
        Dim tmp As Integer
        If str = vbNullChar Then
            'MsgBox("لطفاً کلمه یا جمله‌ای در سلول A1 بنویسید", vbMsgBoxRtlReading)
            Return 0
        End If
        For Each chr As Char In str
            Select Case abjadType
                Case abjadType.vasit
                    tmp += getVasitCharCode(chr)
                Case abjadType.saghir
                    tmp += getSaghirCharCode(chr)
                Case abjadType.kabir
                    tmp += getKabirCharCode(chr)
            End Select
        Next
        Return tmp
    End Function

End Module
