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

السلام عليكم

هذا رابط ملف الوورد

http://mypage.ayna.com/mtarafa/CountLetter.zip

تذكر السماح بتفعيل الماكرو

Tools,Macro,Security Medium

و عند فتح الملف يسأل البرنامج عن تفعيل الماكرو ، فتسمح له

الكود

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  If UCase(Mid(Myword, I, 1)) = UCase(MyLetter) Then Searchit = True
 Next I
 End Function

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

مواضيع مشابهة

عدد الزوار حالياً