VBA ماكرو يقوم بحذف جميع الكلمات فى ملف وورد ، ما عدا التي تحوي حرف معين

VBA ماكرو يقوم بحذف جميع الكلمات فى ملف وورد ، ما عدا التي تحوي حرف معين

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

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

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

Tools,Macro,Security Medium

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

الكود

Public MyLetter As String
Sub DeleteSpecial()
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
Application.ScreenUpdating = True

nextword:
Selection.WholeStory
Mcount = Selection.Words.Count
     ' MsgBox mcount
   For I = 1 To Mcount

   With Selection.Words(I)
          Application.StatusBar = "Searching / Formating ...." & _
             Mcount & "       Please Wait......."
       If Searchit(.Text) = False And .Text <> " " Then
            .Text = " "
             If I = Mcount Then
              Application.ScreenUpdating = True
              Application.StatusBar = False
              MsgBox Str(Mcount - 1) + "Words Remaining", vbInformation, "No of Words Remainnig"
              Exit Sub
             End If
            If Mcount > 1 Then GoTo nextword
       End If
        End With
   Next I

End Sub

Function Searchit(Myword)
Searchit = False
 Dim wLen As Byte
 wLen = Len(Myword)
 For I = 1 To wLen
  If UCase(Mid(Myword, I, 1)) = UCase(MyLetter) Then Searchit = True
 Next I
 End Function