من يساعدنى فى عمل هذا الماكرو

السلام عليكم و رحمة الله و بركاته

نرجو تحديد أيهما المطلوب وورد أم أكسيل حيث أن الحالة مختلفة بالنسبة للمثال المطلوب :cool: :cool: :cool:

ملحوظة علي الماشي : لماذا تحتاج مثال كهذا ؟؟:o :o :o

أريده لملفات ميكروسوفت وورد

لن تتخيل مدى سعادتى لو تمكنت من عمل ذلك

إن شاء الله ستستطيع

والف شكر لك مقدما

السلام عليكم و رحمة الله و بركاته

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

ياسيدى الفاضل ألف الف شكر

ولكن هل من الممكن أن تشرح لى كيف سأضع هذا الماكرو فى وورد ولماذا أرسلته لى على هيئه زيب وليس على هيئة كود أكتبه داخل الماكرو وما معنى تفعيل الماكرو

أرجو منك الصبر فأخوك فقير الى علمك وكلنا فقراء الى الله

والسلام

السلام عليكم و رحمة الله و بركاته

أخي الكريم

الكود المنشور أعلاه قمت بوضعه علي مثال تطبيقي فى ملف وورد ، و بعد ذلك تم ضغطه بال WinZip لكي يسهل نشره

فقم بفك الضغط ستجد برنامج وورد عليه الماكرو جاهز

بالنسبة لتفعيل الماكرو ، هو ان نظام حماية ملفات الوود و الاكسيل 3 مستويات اما ان يسمح بعمل أي ماكرو ، أو أن يخييرك عند فتح الملف ، او أن يبطل عمل جميع الماكروهات

و للتحكم فى ذلك اتبع ما سبق

من قائمة tools

Macro

Security

ثم اختار Medium و بذلك يخيرك عند فتح الملف

بالنسبة للماكروهات فى وورد و اكسيل عموما تابع مجموعة الدروس الخاصة بالاكسل والمنشورة فى الصفحة الرئيسية ، و هي تفيد فى كل من الوورد و الاكسل الي حد كبير

http://www.arabteam2000.com/article.php?sid=13

http://www.arabteam2000.com/article.php?sid=12

أخيرا ، لم تجب لماذا تريد مثل هذا الكود ؟؟؟

أرجو أن تقومي بتجربة هذا الماكرو لعله يفي بالغرض
أرجو أن تجربيه وتدققيه بنفسك وتعلمينني إن كان
بحاجه للتصحيح فأنا لم أدققه لأنني كتبته بإستعمال
برنامج نصوص وليس في بيئة برمجيات.


 

MS Words Macro '

Sub RemoveWord(TXT As String)
On Error Resume Next
Dim W, NR As Long
With ActiveWindow
.Selection.WholeStory
For Each W In .Selection.Words
If InStr(.Selection.Words(NR), TXT) = 0 Then
If .Selection.Words(NR) <> vbCrLf And .Selection.Words(NR) <> _
Chr(vbKeySpace) And .Selection.Words(NR) <> Chr(vbKeyTab) And _
.Selection.Words(NR) <> vbNewLine And .Selection.Words(NR) <> vbLf _
And .Selection.Words(NR) <> vbCr Then
.Selection.Words(NR).Delete
End If
End If

NR = NR + 1
Next
End With
End Sub


Sub TestMacro
RemoveWord "X" 'X يمكن أن يكون اي متغيير
End Sub

تحيه طيبه

السيد الكريم شمس

أعتذر منك لأنني أستعملت صفة الموئنث عندما خاطبتك في ردي على

سوءالك ولكنني يا أخي الكريم معذور فإسم شمس يناسب الجنسين.

على أية حال أنا بهذا لا أنتقص من الجنس الآخر فلو حصل العكس لأعتذرت أيضاً.

مره أخرى عذراً

ياسيدى ولا يهمك

وعلى فكره الماكرو اللى عمله الأخ مصراوى رائع ويعمل بنجاح ولقد جربت كودك ولمنه لم يعمل ربما لأننى لست خبيرا بالماكروهات هذه وربما لخطأ فيه

المهم ألف الف شكر على إهتمامك ومجهودك

وشكرا جزيلا لأخى مصراوىمرة آخرى