سلام
اين هم خدمت شما
فقط براي حروفي مثل " آ " يا " ئـ " يا مشابه عددي تعريف نشده
نكته ديگه اي كه هست اينه كه ممكنه براي حروف " ك " يا " ي " دچار مشكل بشي كه با يه عغيير كوچيك قابل رفع هست
پس پيشنهاد نيكنم چند تايي كلمه كه داراي اين دو حرف هستن رو امتحان كني
براي 32 حرف معمولي اعداد 1 تا 32 تعريف شده
براي اجرا هم كافيه ماكرويي به نام WordSumEXE رو اجرا كني
کد:
Function WordSum(S As String) As Integer
Dim CharArray As Variant
Dim NumArray As Variant
Dim i, j As Integer
CharArray = Array("ا", "ب", "پ", "ت", "ث", "ج", "چ", "ح", "خ", "د", "ذ", "ر", "ز", "ژ", "س", "ش", "ص", "ض", "ط", "ظ", "ع", "غ", "ف", "ق", "ك", "گ", "ل", "م", "ن", "و", "ه", "ي")
NumArray = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32)
WordSum = 0
For i = 1 To Len(S)
For j = 0 To 31
If Mid(S, i, 1) = CharArray(j) Then WordSum = WordSum + NumArray(j)
Next j
Next i
End Function
Sub WordSumEXE()
Dim WS As Integer
WS = WordSum(Selection)
Selection.EndKey Unit:=wdLine
Selection.TypeText Text:=" .... "
Selection.TypeText Text:=WS
End Sub