هدية رمضان

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

التاكيد من مدخلات المستخدم وطول الاسم وتوحيد الاسماء والمسفات الزائده والهمزات

مثل اريد ادخال الاسماء الثلاثية فقط

محمد عبد الله -محمد ابو العنين هو ثنائي ليس ثلاثي الصح محمد عبدالله- محمد ابو العنين

مثل علي توحيد الاسماء

احمد-أحمد-إحمد =احمد

	Public Function GetConTxtAr(ByVal sString As String) As String
		Dim s1, s2, sTotal As String
		sString = Trim(sString)
		Dim I As Integer
		For I = 1 To Len(sString)

			s1 = Mid(sString, I, 1)

			If I < Len(sString) - 1 Then
				s2 = Mid(sString, I + 1, 1)
			Else
				s2 = ""
			End If

			If s1 = " " And s2 = "" Then s1 = ""

			If s1 = " " And s2 = " " Then s1 = ""

			If s1 = "أ" Or s1 = "إ" Or s1 = "آ" Then s1 = "ا"

			If s1 = "ي" And s2 = " " Or s1 = "ي" And I = Len(sString) Then s1 = "ى"

			If s1 <> "" Then If Asc(s1) = Asc("ة") And s2 = " " Or Asc(s1) = Asc("ة") And I = Len(sString) Then s1 = "ه"

			If s1 = "لإ" Or s1 = "لأ" Or s1 = "لآ" Then s1 = "لا"

			If s1 = "ؤ" Then s1 = "و"

			If I <= Len(sString) - 4 And I > 2 Then
				If Mid(sString, I - 2, 6) = "عبد ال" Then
					s1 = "د"
					I = I + 1
				End If

				If Mid(sString, I - 2, 4) = "ابو " Then
					s1 = "و"
					I = I + 1
				End If

				If Mid(sString, I, 6) = " الدين" Then
					s1 = "."

				End If

			End If

			If I >= 3 Then
				If s2 = " " And s1 = "و" And Mid(sString, I - 1, 1) = " " Then
					s1 = "و"
					I = I + 1
				End If
			End If

			sTotal = sTotal + s1
		Next I

		GetConTxtAr = Trim(sTotal)
	End Function