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

[عبدالعليم اسماعيل]

 

عند كتابة اى اسم يبداء بعبد يأخذ  مسافه تلقائيه بدون استعلام

abdo.accdb

[Moosak]

 في حدث بعد التحديث (يعني بعد كتابة الاسم كاملا) تكتب هذا 
 

Replace ( [NameText], "عبد " , "عبد")
' للتأكد من عدم وجود مسافتين
Replace ( [NameText], "  عبد " , "عبد")

 

[figo82eg]

وفى حالة وجود اسماء بها حروف مثل

١ - ( ة ) فى نهاية الكلمة اريد استبدالها تلقائى بحرف ( ه ) 

٢ - ( ي ) فى نهاية الكلمة اريد استبدالها تلقائى بحرف ( ى )

٣ - ( عبدالله ) تكون ( عبد الله ) 

[Moosak]

17 دقائق مضت, figo82eg said:

وفى حالة وجود اسماء بها حروف مثل

١ - ( ة ) فى نهاية الكلمة اريد استبدالها تلقائى بحرف ( ه ) 

٢ - ( ي ) فى نهاية الكلمة اريد استبدالها تلقائى بحرف ( ى )

٣ - ( عبدالله ) تكون ( عبد الله ) 

استخدم نفس الدالة Replace

🙂 

[ابوخليل]

في 20‏/9‏/2023 at 08:03, Moosak said:

 في حدث بعد التحديث (يعني بعد كتابة الاسم كاملا) تكتب هذا 
 

Replace ( [NameText], "عبد " , "عبد")
' للتأكد من عدم وجود مسافتين
Replace ( [NameText], "  عبد " , "عبد")

 

جميل .. واذا الاسم عبدون هل سيفصله؟ .. عندنا عائلة اسمها العبدان 

[Moosak]

4 دقائق مضت, ابوخليل said:

جميل .. واذا الاسم عبدون هل سيفصله؟ .. عندنا عائلة اسمها العبدان 

ماذا تقترح عمي @ابوخليل 🙂 

هات ما في جعبتك 😁

[ابوخليل]

 

6 دقائق مضت, Moosak said:

ماذا تقترح عمي @ابوخليل 🙂 

لا شيء .. فاللغة العربية بحر  ..

" سددوا وقاربوا " .. والمقاربة هنا جميلة .. ما يخرج عن السياق لا يصل عدد اصابع اليد الواحدة

 

[ابو جودي]

في 20‏/9‏/2023 at 03:30, عبدالعليم اسماعيل said:

عند كتابة اى اسم يبداء بعبد يأخذ  مسافه تلقائيه بدون استعلام

ابشر بالخير ان شاء الله جارى العمل على اعداد الكود

[ابو جودي]

وأخيرا ً بحمد الله الذى تتم بنعمته الصالحات 

ضع للكود الاتى فى وحدة نمطيه

Public Function MultiReplacements(ByVal varInput As String, ParamArray varReplacements() As Variant)
On Error GoTo ErrorHandler
  
  Dim n As Integer
  Dim varOutput As Variant
  Dim intParamsCount As Integer
  If Nz(varInput, "") = "" Then Exit Function
  
'  varInput = Nz(varInput, 0)
    'If Not IsNull(varInput) Then
    If Len(varInput & "") > 0 Then
        intParamsCount = UBound(varReplacements) + 1
        If intParamsCount Mod 2 = 0 Then
            varOutput = varInput
            For n = 0 To UBound(varReplacements) Step 2
                varOutput = Replace(varOutput, varReplacements(n), varReplacements(n + 1))
            Next n
        Else
        Exit Function
        End If
    End If
    MultiReplacements = varOutput
    
ExitHandler:
   Exit Function
ErrorHandler:


  Select Case Err.Number
    Case Is = 94: Resume ExitHandler
    Case Else
      MsgBox "Error Number : " & Err.Number & vbNewLine & "Error Description : " & Err.Description
    Resume ExitHandler
  End Select
End Function



Public Function ReplaceResult(ByVal strInput As String)
If Nz(strInput, "") = "" Then Exit Function
  ReplaceResult = MultiReplacements(strInput, ChrW(1577), ChrW(1607), _
                                              ChrW(32), ChrW(32), _
                                              ChrW(1610) & ChrW(32), ChrW(1609) & ChrW(32), _
                                              ChrW(1593) & ChrW(1576) & ChrW(1583) & ChrW(1575) & ChrW(1604), ChrW(1593) & ChrW(1576) & ChrW(1583) & ChrW(32) & ChrW(1575) & ChrW(1604), _
                                              ChrW(1593) & ChrW(1576) & ChrW(1583) & ChrW(32) & ChrW(1575) & ChrW(1604) & ChrW(32), ChrW(1593) & ChrW(1576) & ChrW(1583) & ChrW(1575) & ChrW(1604) & ChrW(32), _
                                              ChrW(1593) & ChrW(1576) & ChrW(1583) & ChrW(1585) & ChrW(1576) & ChrW(32), ChrW(1593) & ChrW(1576) & ChrW(1583) & ChrW(32) & ChrW(1585) & ChrW(1576) & ChrW(32), _
                                              ChrW(1593) & ChrW(1576) & ChrW(1583) & ChrW(1605) & ChrW(1575) & ChrW(1604) & ChrW(1603), ChrW(1593) & ChrW(1576) & ChrW(1583) & ChrW(32) & ChrW(1605) & ChrW(1575) & ChrW(1604) & ChrW(1603) _
                                    )
End Function

ويتم استدعاءه كالتالى

ReplaceResult([txt])

 

واخيرا المرفق

الاسماء المركبة.accdb

[ابوخليل]

وهذا حل مشابه لما تفضل به اخوي موسى مع بعض الاضافات

 

Private Sub txt1_AfterUpdate()
Dim i As String
Me.txt1.SetFocus
i = Me.txt1.Value
i = Replace(i, "عبد", "عبد" & " ")
 Me.txt1 = i
End Sub

 

الاسماء المركبة2.accdb

[AbuuAhmed]

‏الأفضل عدم وضع مسافة بين (عبدالله) إذا كان اسم إنسان، أما إذا وصفًا فتوضع مسافة، نحو: يا زيد أنت عبد الله وإليه تدعو.

 

وكذلك كل الأسماء المعبدة.

[ابو جودي]

5 ساعات مضت, ابوخليل said:

وهذا حل مشابه لما تفضل به اخوي موسى مع بعض الاضافات

Private Sub txt1_AfterUpdate()
Dim i As String
Me.txt1.SetFocus
i = Me.txt1.Value
i = Replace(i, "عبد", "عبد" & " ")
 Me.txt1 = i
End Sub

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

لازلت المشكلة قائمة 

لو كتبنا مثلا

احمد العبدان عبد الله

نحصل على 

احمد العبد ان عبد  الله

يمكننا اضافة بعد التعديلات للحصول على الاسم بدون عدد 2 مسافة 

لكن عائلة العبدان إن حضرت الينا ماذا نفعل معهم ؟ 

وحتى لاتزعل منا عائلة العبدان 

نستخدم هذا الكود

Dim i As String
Me.txt1.SetFocus
i = Me.txt1.Value
i = Replace(i, "عبدال", "عبد ال" & "")
i = Replace(i, "عبدرب", "عبد رب" & "")
 Me.txt1 = i

 

[AbuuAhmed]

في 20‏/9‏/2023 at 03:30, عبدالعليم اسماعيل said:

عند كتابة اى اسم يبداء بعبد يأخذ  مسافه تلقائيه بدون استعلام

نصحتك باستخدام ما عبد من الأسماء بالشكل الصحيح، و "طنشتني"
هل تعلم أن عندك 4 كلمات بها خطأ إملائي من أصل 11 كلمة. يجب الاهتمام باللغة والإملاء.

على كل هذا اقتراح برمجي لطلبك:
 

Me.txt1 = Replace(Me.txt1, "عبدال", "عبد ال", 1)

 

[AbuuAhmed]

وهذه بعد مشاهدتي لمشاركة الأستاذ أبو جودي:
 

Me.txt1 = Replace(Replace(Me.txt1, "عبدال", "عبد ال"), "عبدرب", "عبد رب")

 

[ابو جودي]

5 دقائق مضت, AbuuAhmed said:

وهذه بعد مشاهدتي لمشاركة أبو جودي:

Me.txt1 = Replace(Replace(Me.txt1, "عبدال", "عبد ال"), "عبدرب", "عبد رب")

ههههههه اى خدمه علشان تعرف بس انا مصحصح
 

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

[AbuuAhmed]

أكيد بتكون بنفس الطريقة:
 

    Me.txt1 = Replace(Me.txt1, "عبدال", "عبد ال")
    Me.txt1 = Replace(Me.txt1, "عبدرب", "عبد رب")
    Me.txt1 = Trim(Replace(Me.txt1 & " ", "ة ", "ه "))
    Me.txt1 = Trim(Replace(Me.txt1 & " ", "ي ", "ى "))

تم التعديل في حالة أن التاء أو الياء في الإسم الأخير.

تم تعديل سبتمبر 25, 2023 بواسطه AbuuAhmed

[ابو جودي]

وهذ الكود ان شاء الله يفى بالغرض كما هو المطلوب 

Public Function MultiReplacements(Optional ByVal strInput As String = "") As String
If Nz(strInput, "") = "" Then Exit Function

strInput = Replace(strInput, "ي ", "ى " & "")
strInput = Left(strInput, Len(strInput) - 1) + Replace(Right(strInput, 1), "ي", "ى")
strInput = Replace(strInput, "ة", "ه" & "")
strInput = Replace(strInput, "عبدال", "عبد ال" & "")
strInput = Replace(strInput, "عبدرب", "عبد رب" & "")

MultiReplacements = strInput
End Function

وطبعا لتجنب حدوث اى مشاكل بسبب استخدام الاحرف العربية داخل محرر الاكواد افضل استخدام الكود الاتى 

Public Function MultiReplacements(Optional ByVal strInput As String = "") As String
If Nz(strInput, "") = "" Then Exit Function

strInput = Replace(strInput, ChrW(1610) & ChrW(32), ChrW(1609) & ChrW(32) & "")
strInput = Left(strInput, Len(strInput) - 1) + Replace(Right(strInput, 1), ChrW(1610), ChrW(1609))
strInput = Replace(strInput, ChrW(1577), ChrW(1607) & "")
strInput = Replace(strInput, ChrW(1593) & ChrW(1576) & ChrW(1583) & ChrW(1575) & ChrW(1604), ChrW(1593) & ChrW(1576) & ChrW(1583) & ChrW(32) & ChrW(1575) & ChrW(1604) & "")
strInput = Replace(strInput, ChrW(1593) & ChrW(1576) & ChrW(1583) & ChrW(1585) & ChrW(1576), ChrW(1593) & ChrW(1576) & ChrW(1583) & ChrW(32) & ChrW(1585) & ChrW(1576) & "")

MultiReplacements = strInput
End Function

 

[عبدالعليم اسماعيل]

10 دقائق مضت, ابو جودي said:

وهذ الكود ان شاء الله يفى بالغرض كما هو المطلوب 

Public Function MultiReplacements(Optional ByVal strInput As String = "") As String
If Nz(strInput, "") = "" Then Exit Function

strInput = Replace(strInput, "ي ", "ى " & "")
strInput = Left(strInput, Len(strInput) - 1) + Replace(Right(strInput, 1), "ي", "ى")
strInput = Replace(strInput, "ة", "ه" & "")
strInput = Replace(strInput, "عبدال", "عبد ال" & "")
strInput = Replace(strInput, "عبدرب", "عبد رب" & "")

MultiReplacements = strInput
End Function

وطبعا لتجنب حدوث اى مشاكل بسبب استخدام الاحرف العربية داخل محرر الاكواد افضل استخدام الكود الاتى 

Public Function MultiReplacements(Optional ByVal strInput As String = "") As String
If Nz(strInput, "") = "" Then Exit Function

strInput = Replace(strInput, ChrW(1610) & ChrW(32), ChrW(1609) & ChrW(32) & "")
strInput = Left(strInput, Len(strInput) - 1) + Replace(Right(strInput, 1), ChrW(1610), ChrW(1609))
strInput = Replace(strInput, ChrW(1577), ChrW(1607) & "")
strInput = Replace(strInput, ChrW(1593) & ChrW(1576) & ChrW(1583) & ChrW(1575) & ChrW(1604), ChrW(1593) & ChrW(1576) & ChrW(1583) & ChrW(32) & ChrW(1575) & ChrW(1604) & "")
strInput = Replace(strInput, ChrW(1593) & ChrW(1576) & ChrW(1583) & ChrW(1585) & ChrW(1576), ChrW(1593) & ChrW(1576) & ChrW(1583) & ChrW(32) & ChrW(1585) & ChrW(1576) & "")

MultiReplacements = strInput
End Function

 

الشكر كل الشكر