جایگزینی متن عربی با اعراب با متن عربی بدون اعراب

[hamed2439]

سلام دوستان

من میخوام تابعی باشه که از یک تکست باکس متن عربی با اعراب رو بگیره و در یک تکست باکس دیگه همون متن رو بدون اعراب درج کنه

ممنون میشم کمکم کنید

با تشکر

[hamed2439]

خودم جوابش رو پیدا کردم

اینجا میذارم شاید به درد بقیه هم بخوره

دو روش هست برای اینکار
یکی استفاده کردن از ریفرنس و یکی بدون ریفرنس که هم سرعتش بالاتره هم خیلی ساده هست

من روش بدون ریفرنس رو میذارم

دقیقا میشه این تابع

فرض میکنیم یه تکست باکس داریم به نام Text و و یک دكمه داریم که در کد اون دكمه اینو میذاریم
Dim Text, Aarab, SP() As String

Text = "سَلام"
Aarab = "َ"
SP = Split(Aarab, "")

For i = 0 To Len(Aarab) - 1
Text = Replace(Text, SP(i), "")
Next i

MsgBox Text

تمام شد ...
متن با اعراب رو میگیره و بدون اعراب تحویل میده
البته در این مثال فقط فتحه لحاظ شده و شما میتونید بقیه اعراب رو در ادامه اون فتحه اضافه کنید ( بدون فاصله و بدون کاراکتر اضافه )

[miladatashin]

چرا حلقه؟!

Text1 = Replace(Text1, "ó", "")

همین یک خط کل فتحه ها رو حذف میکنه

[vbhamed]

سلام
كدتون يك مقدار مشكل داشت كه حلش كردم، براي اضافه كردن اعراب جديد يك كاراكتر كشيدن خط تايپ كنيد و بعد اعراب (اين كاراكتر يعني "_" با Shift+J در حالت فارسي تايپ ميشه)
Private Function RemoveErab(ByVal s As String) As String

Dim Erab, SP() As String, i&

Erab = "ـَـِـُـًـٍـٌـّـْ"
SP = Split(Erab, "ـ")

For i = 0 To UBound(SP)
s = Replace(s, SP(i), "")
Next

RemoveErab = s

End Function

Private Sub Form_Load()

Dim s$
s = "وَ الَّذينَ يُؤْمِنُونَ بِما أُنْزِلَ إِلَيْكَ وَ ما أُنْزِلَ مِنْ قَبْلِكَ وَ بِالْآخِرَةِ هُمْ يُوقِنُونَ"
MsgBox s & vbCrLf & RemoveErab(s)

End Sub

[hamed2439]

سپاس از مطلبی که اشاره کردین
در حالت مثال که فقط یک فتحه هست حق با شماست

اما در یک آیه کامل که شامل چندین فتحه باشه نیاز به حلقه هست که تمامی فتحه ها رو حذف بکنه
برای همین از حلقه استفاده میشه


چرا حلقه؟!

Text1 = Replace(Text1, "ó", "")

همین یک خط کل فتحه ها رو حذف میکنه

[vbhamed]

سپاس از مطلبی که اشاره کردین
در حالت مثال که فقط یک فتحه هست حق با شماست

اما در یک آیه کامل که شامل چندین فتحه باشه نیاز به حلقه هست که تمامی فتحه ها رو حذف بکنه
برای همین از حلقه استفاده میشه

سلام
نياز به حلقه نيست
همونطور كه miladatashin عزيز اشاره كردن دستور Replace كل فتحه ها رو با هم حذف مي‌كنه