اذهب الي المحتوي
أوفيسنا

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

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

بواسطه عبدالعليم اسماعيل
في قسم الأكسيس Access

 مشاركة
إذهب إلى أفضل إجابة Solved by ابوخليل,

الردود الموصى بها

Moosak

Moosak

قام بنشر
قام بنشر

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

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

 

  • Like 2
figo82eg

figo82eg

قام بنشر
قام بنشر

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

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

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

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

Moosak

Moosak

قام بنشر
قام بنشر
17 دقائق مضت, figo82eg said:

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

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

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

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

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

🙂 

ابوخليل

ابوخليل

قام بنشر
قام بنشر
في 20‏/9‏/2023 at 08:03, Moosak said:

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

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

 

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

  • Haha 2
Moosak

Moosak

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

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

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

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

ابوخليل

ابوخليل

قام بنشر
قام بنشر

 

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

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

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

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

 

  • Like 1
ابو جودي

ابو جودي

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

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

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

ابو جودي

ابو جودي

قام بنشر
قام بنشر

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

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

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

  • Like 2
  • أفضل إجابة
ابوخليل

ابوخليل

قام بنشر
  • أفضل إجابة
قام بنشر

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

  

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

  • Like 2
AbuuAhmed

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

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

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

لو كتبنا مثلا

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

نحصل على 

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

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

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

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

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

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

 

AbuuAhmed

AbuuAhmed

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

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

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

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

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

 

AbuuAhmed

AbuuAhmed

قام بنشر
قام بنشر

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

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

 

  • Haha 1
ابو جودي

ابو جودي

قام بنشر
قام بنشر
5 دقائق مضت, AbuuAhmed said:

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

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

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

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

  • Like 1
AbuuAhmed

AbuuAhmed

قام بنشر
قام بنشر (معدل)

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

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

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

تم تعديل بواسطه AbuuAhmed
  • Like 1
ابو جودي

ابو جودي

قام بنشر
قام بنشر

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

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

 

  • Like 2
  • Thanks 1
عبدالعليم اسماعيل

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

قام بنشر
  • الكاتب
قام بنشر
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

 

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

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 مشاركة
الذهاب الي قائمه المواضيع

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information

  I accept