الى عمالقة البرمجة فيجوال بيسك + اكسل سؤال

[mercury_man]

السلام عليكم ورحمة الله
اريد الكود البرمجي لحذف جميع الحروف العربية من مستند اكسل
وذلك باستخدام فيجوال بيسك للتطبيقات VBA
اي اريد العمل من ضمن بيئة اكسل
لكن في الحقيقة لا اعرف الامر الذي يقوم بحذف الحروف
اعتقد افضل حل هو عمل استبدال للحروف بفراغ
سبق لي العمل في بيئة فيجوال بيسك للتطبيقات مع برنامج اوتوكاد شكل احترافي وبرنامج وورد بصورة بسيطة اما اكسل لم يسبق لي ذلك
رجاءا المطلوب حذف الحروف العربية او استبدالها بفراغ في الاكسيل حصرا
شاكرا لطفكم

[MUHANNAD123]

أخي ممكن توضح أكثر بالأمثلة
يعني هل تريد أن يتم الحذف بخلية محدد سلفا أو بكامل المستند أو يتم مسح جميع محتوى الخلية
وماهو المطلوب اذا واجهك نص مثل كتbookاب هل تريد مسح الحرف العربية فقط وابقاء الكلمة الانجليزية فقط وماذا عن الأرقام

يعني شوية توضيح بالأمثلة وراح أحاولك فيها على قدر استطاعتي ولاقيلك الحل انشاء الله

[mercury_man]

أخي ممكن توضح أكثر بالأمثلة
يعني هل تريد أن يتم الحذف بخلية محدد سلفا أو بكامل المستند أو يتم مسح جميع محتوى الخلية
وماهو المطلوب اذا واجهك نص مثل كتbookاب هل تريد مسح الحرف العربية فقط وابقاء الكلمة الانجليزية فقط وماذا عن الأرقام

يعني شوية توضيح بالأمثلة وراح أحاولك فيها على قدر استطاعتي ولاقيلك الحل انشاء الله

اشكرك اخي الكريم على المساعدة
عندي مستندات كثيرة تحتوي كلام عربي وانكليزي اريد حذف كل الكلمات العربية بضغطة زر واحدة اما الارقام والحروف الانكليزية باقة
اعتقد الاسها استعمال محرر الفيجوال بيسك من داخل الاكسيل
بانتظار المساعدة ضروري

[MUHANNAD123]

 Dim CellString As String, I As Integer
CellString = ActiveCell.Value
Start:
For I = 1 To Len(CellString)
If InStr(1, "ÐÏÌÍÎåÚÛÅÝÞËÕÖØßãäÊÇÃáÈíÓÔÙÒæÉìÂÑÄÁÆ", Mid(CellString, I, 1)) > 0 Then
CellString = Left(CellString, I - 1) & Mid(CellString, I + 1, Len(CellString) - I)
GoTo Start
End If
Next
 
ActiveCell.Value = CellString 
  

طبعا بدل الكلام الموجود باللون الأحمر تضع جميع الأحرف العربية التي تود ازالتها وبشكل متصل بدون فراغات مثل "دجحخهععغفقثقثصضطكممننتتااي" ولاأدري لماذا ظهرت بهذا الشكل عندما لصقت الكود واي استفسار أنا جاهز
هذا مبدئيا واذا عند تعديلات ارجو اخباري بها للوصول الى غايتك
هذا الكود هو لحذف جميع الأحرف العربية في الخلية الفعالة فقط

[وضاح عطار]

هذا ما خطر ببالي

قم بتسجيل ماكرو من خلال الاكسيل

ثم قم بعمل استبدال حرف ألف العربي بلا شيء

ثم اوقف تسجيل الماكرو

اذهب إلى الماكرو ستجد كود لاستبدال الحرف ألف بلا شيء .

قم بتكرار سطر الاستبدال لكل حرف عربي آخر

احفظ الكود ثم نفذه على الوثيقة

[mercury_man]

 Dim CellString As String, I As Integer
CellString = ActiveCell.Value
Start:
For I = 1 To Len(CellString)
If InStr(1, "ÐÏÌÍÎåÚÛÅÝÞËÕÖØßãäÊÇÃáÈíÓÔÙÒæÉìÂÑÄÁÆ", Mid(CellString, I, 1)) > 0 Then
CellString = Left(CellString, I - 1) & Mid(CellString, I + 1, Len(CellString) - I)
GoTo Start
End If
Next
 
ActiveCell.Value = CellString 
  

طبعا بدل الكلام الموجود باللون الأحمر تضع جميع الأحرف العربية التي تود ازالتها وبشكل متصل بدون فراغات مثل "دجحخهععغفقثقثصضطكممننتتااي" ولاأدري لماذا ظهرت بهذا الشكل عندما لصقت الكود واي استفسار أنا جاهز
هذا مبدئيا واذا عند تعديلات ارجو اخباري بها للوصول الى غايتك
هذا الكود هو لحذف جميع الأحرف العربية في الخلية الفعالة فقط

شكرا جزيلا لك اخي الكريم لكن لا اعلم لماذا الكود لا يعمل ممكن بسبب طريقة كتابة الحروف

[mercury_man]

هذا ما خطر ببالي

قم بتسجيل ماكرو من خلال الاكسيل

ثم قم بعمل استبدال حرف ألف العربي بلا شيء

ثم اوقف تسجيل الماكرو

اذهب إلى الماكرو ستجد كود لاستبدال الحرف ألف بلا شيء .

قم بتكرار سطر الاستبدال لكل حرف عربي آخر

احفظ الكود ثم نفذه على الوثيقة

شكرا لك اخي العزيز وضاح دائما سباق الى الخير
فعلا جربت المايرو الذي ذكرته وهو المطلوب بالضبط
جزاك الله كل خير ووفقك لما يحب ويرضى
الكود كالتالي

    Cells.Replace What:="ا", Replacement:=" ", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False