أحتاج كود يقوم بفلترة بعض الأحرف العربية

أستعمل Replace

Text1.Text = Replace (Text1.Text , "ن","ل")

تعديل : آسف أنا مقرأتش مشاركتك بالكامل و بالتالى فهمتك غلط , ربنا يسهل و أعملك مثال.

اخي الكريم هذا كود كتبته على الماشي حاول فهمه و التعديل عليه

' super_pro , WWW.arabteam2000.com

Private Sub Command1_Click()
Dim OBjectString(1) As String
Dim ModifiedString(1) As String
OBjectString(0) = "Ã"
OBjectString(1) = "í"

ModifiedString(0) = "Ç"
ModifiedString(1) = "ì"

For i = 0 To 1

   If InStr(1, Text1.Text, OBjectString(i)) = 1 Or InStr(1, Text1.Text, OBjectString(i)) = Len(Text1.Text) Then
   Text1.Text = Replace(Text1.Text, OBjectString(i), ModifiedString(i))
   End If
 Next


End Sub

مع العلم و جود خلل بسيط في الكود((((لضيق الوقت))))

ليس error في الفيجوال بيسك و لكن من حيث المطلو ب منه الصرحه نسيت ما يطلق على هذا النوع من الاخطاء :s

حاول اكتشافه وان لم تستطيع حاول تذكير عن طريق الخاص لاحله لك

ملاحظة

OBjectString(0) = "Ã"
OBjectString(1) = "í"

ModifiedString(0) = "Ç"
ModifiedString(1) = "ì"

حيث الخربيط :wacko: التالية

"Ã = أ

"í = ي

"Ç = ا

"ì = ى

لا اعرف كيف تم تحريفها :lol: م

ربنا يسهل و أعملك مثال

اقتباس

ربنا يسهل و أعملك مثال

أشكرك اخي الفاضل msayed2004 على مرورك و ردك و تعاونك

و في إنتظار المثال اذا أمكن ...(ربنا يسهل و تقدر تكتبه)

تحياتي

هلا و غلا اخي Super_Pro

مشكور على ردك ...فعلا هذا ما كنت ابحث عنه

لكن اذا ممكن تقولي كبف ممكن اعمل تنقيه للكلمة التي تبدا بحرف مثل (أ . إ . ) الى (ا)

و تنقيه ثانيه للكلمة التي تنتهي بحرف مثل (ي . ة . ) لتصبح (ى . ه)

و كتر الف خيرك

و شاكر جدا لتعاونك و ردك

هيبقى بنفس الفكرة دى :

Private Function ProccessTexts(sText As String) As String
Dim sDummy As String

sDummy = Trim$(sText)

If Left$(sDummy, 1) = "أ" Then
	sDummy = "ا" & Right$(sDummy, Len(sDummy) - 1)
End If

If Right$(sDummy, 1) = "ي" Then
	sDummy = Left$(sDummy, Len(sDummy) - 1) & "ى"
End If

ProccessTexts = sDummy
End Function

Private Sub txtName_Validate(Cancel As Boolean)
txtName.Text = ProccessTexts(txtName.Text)
End Sub

طبعا اخي العفو و الله يقدرنا على مساعده الاخرين

احبيت ان اضع الاجابه هنا وليس على الخاص فلا نعلم ربما يستفيد منها شخص اخر ;)

طبعا كما لاحظت في الكود السابق قمنا بتعريف مصفوفتين الاولى لوضع الحرف المطلوب ابداله

و المصفوفة الثانية الحرف البديل لها على نفس الموقع ضمن المصفوفة مقارنه في المصفوفة الاولي

مثال

حرف "أ" ضمن المصفوفة الاولى موقعه 0 وفي المصفوفة الثانيه البديل له على نفس الموقع و هو "ا" الموقع 0

و هكذا بما اننا فهمنا طريق عمل الكود السابق الان ما علينا سوى تطوير كلا المصفوفتين للتضم المصفوفة الاولى الاحرف المراد استبدالها

مثلا (أ : إ : ة :ي ) و نضع في المصفوفة الثانية البدائل ضمن نفس الترتيب (ا : ا : ه : ى)

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

مشكوووووووووووووووووور msayed2004 على ردك و مساعدتك

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

بارك الله فيك

و انت أخي العزيز Super_Pro

الف شكر لك على سعة صدرك و تجاوبك

و في غنتظار المثال المطور لديك ...

و بذلك يكون ربنا أكرمني بمثال رائع من msayed2004 و مثال مطور من Super_Pro

فبإذن الله لن ينقصني شيء بعد ذلك

و ذلك بفضل جهودكم

مع أجمل التمنيات

على الرحب و السعه في اي وقت اخي الكريم

وفي خدمتك باي معلومه اقدر عليها و ها هو المثال

' super_pro www.arabteam2000.com

Private Sub Command1_Click()
Call Filtertxt(" " & Text1.Text & " ")



End Sub



Private Function Filtertxt(txt As String) As String

Dim ObjecTxt(3), modifyTxt(3) As String

ObjecTxt(0) = "أ"
ObjecTxt(1) = "ي"
ObjecTxt(2) = "ة"
ObjecTxt(3) = "إ"

modifyTxt(0) = "ا"
modifyTxt(1) = "ى"
modifyTxt(2) = "ه"
modifyTxt(3) = "ا"

For i = 1 To Len(txt)
If Mid(txt, i, 1) <> " " Then
If Mid(txt, i + 1, 1) = " " Or Mid(txt, i - 1, 1) = " " Then
For j = 0 To 3
If ObjecTxt(j) = Mid(txt, i, 1) Then
txt = Left(txt, i - 1) & modifyTxt(j) & Right(txt, Len(txt) - i)
Text1.Text = Trim(txt)
Exit For
End If
Next
End If
End If
Next

End Function

و السلام عليكم ;)