الحصول علي عدد تكرار حرف معين فى الوورد

[محمد طاهر عرفه]

VBA ماكرو يقوم بعد عدد الحروف من حرف معين فى وورد مع الأخذ بالاعتبار أن ال أ =ا=آ

Public MyLetter As String

Sub Countaletter()

MyLetter = InputBox("Enter the Letter", "Delete Except that letter", "M")

If Len(MyLetter) > 1 Then

 MsgBox "Write One Chr Please !", vbExclamation, "One Chr is only Allowed"

 Exit Sub

End If


MyLetter = Searchit(MyLetter)


Application.ScreenUpdating = True

Mycounter = 0

Selection.WholeStory

Mcount = Selection.Characters.Count

     ' MsgBox mcount

   For I = 1 To Mcount


   With Selection.Characters(I)

          Application.StatusBar = "Searching  ...." & _

             I & "/" & Mcount & "       Please Wait......."

       If Searchit(.Text) = MyLetter Then

        Mycounter = Mycounter + 1

       End If

        End With

   Next I

   

   MsgBox Str(Mycounter) + " Matches of Letter  " + MyLetter


End Sub


Function Searchit(Mychr)


If Mychr = "Ã" Or Mychr = "Å" Or Mychr = "Â" Then

 Mychr = "Ç"

End If


If Mychr = "í" Or Mychr = "ì" Then

 Mychr = "ì"

End If

Searchit = Mychr

End Function

CountLetter.zip