محمد طاهر

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

1 مشاركة في هذا الموضوع

السلام عليكم

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

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

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
زوار
This topic is now closed to further replies.

  • يستعرض القسم حالياً   0 members

    لا يوجد أعضاء مسجلين يشاهدون هذه الصفحة .