اختيار الكلمة الاولى فقط من مربع نص

[سمير1404]

تحية طيبة للجميع وتقبل الله طاعاتكم

اتمنى ان اجد الحل لديكم

 لدي مربع نص 1 ومربع نص 2 وزر امر 

اريد عند الضغط على زر الامر ان يتم تلقائيا تعبئة مربع النص الثاني بناء على اول كلمة فقط من مربع النص رقم واحد 

مثلا اذا كان مربع النص رقم 1 يوجد به عبارة مصر العربية  يكون مربع النص 2  عند الضغط على زر الامر جمهورية مصر العربية 

وهكذا مثلا العربية السعودية عند الضغط على زر الامر يكون مربع النص 2 المملكة العربية السعودية 

فيكون قراءة او كلمة فقط في مربع النص 1

db2_text.mdb

[عمر ضاحى]

19 دقائق مضت, سمير1404 said:

تحية طيبة للجميع وتقبل الله طاعاتكم

اتمنى ان اجد الحل لديكم

 لدي مربع نص 1 ومربع نص 2 وزر امر 

اريد عند الضغط على زر الامر ان يتم تلقائيا تعبئة مربع النص الثاني بناء على اول كلمة فقط من مربع النص رقم واحد 

مثلا اذا كان مربع النص رقم 1 يوجد به عبارة مصر العربية  يكون مربع النص 2  عند الضغط على زر الامر جمهورية مصر العربية 

وهكذا مثلا العربية السعودية عند الضغط على زر الامر يكون مربع النص 2 المملكة العربية السعودية 

فيكون قراءة او كلمة فقط في مربع النص 1

db2_text.mdb 148 kB · 2 downloads

طيب ايه المعيار هنا ؟

يعنى مصدر الكلمة التى سوف تضاف اين وايه معيار الاختيار هنا ؟

[سمير1404]

النموذج مسمتمر الكود وظيفته يقراء مربع النص 1 للجميع ويضيف الكلمة المناسبة في مربع النص 2 في البداية مثلا مصر في مربع النص 1 تنسخ بالكامل وتضاف في مربع النص2 ويكون قبلها كلمة جمهورية مصر العربية وهكذا للبقية اعتقد انه يلزم استخدام دالة الشرط فمصر جمهورية والسعودية مملكة واالاردن مملكة وهكذا ،، لعلي اوصلت المعلومة 

[عمر ضاحى]

3 دقائق مضت, سمير1404 said:

النموذج مسمتمر الكود وظيفته يقراء مربع النص 1 للجميع ويضيف الكلمة المناسبة في مربع النص 2 في البداية مثلا مصر في مربع النص 1 تنسخ بالكامل وتضاف في مربع النص2 ويكون قبلها كلمة جمهورية مصر العربية وهكذا للبقية اعتقد انه يلزم استخدام دالة الشرط فمصر جمهورية والسعودية مملكة واالاردن مملكة وهكذا ،، لعلي اوصلت المعلومة 

انا فاهم حضرتك 

لكن ما تريده كانك بتطلب من شخص ان يبني احتمالات لجميع دول العالم ^_^

لكن ممكن نبدأ الفكره باستخدام دالة Like

ويكون هناك دالة شرطيه طويييييله لجميع دول العالم 

 

خلينى اجرب شئ وارجعلك

[سمير1404]

نعم اخوي عمر صدقت كلامك صحيح بالضبط انا ارتد ان اصل الى الحل لان الاحتمالات الموجودة عندي هي محددة لا تخرج عن 20 احتمال تقريبا

[عمر ضاحى]

مبدئيا هيكون هنا الشروط 

If Me.text1 Like "*" & "مصر" & "*" Then
    Me.text2 = "جمهورية مصر العربيه"
ElseIf Me.text1 Like "*" & "السعودية" & "*" Then
    Me.text2 = "المملكة العربيه السعودية"

ElseIf Me.text1 Like "*" & "الامريكية" & "*" Then
    Me.text2 = "الولايات المتحده الامريكيه"

ElseIf Me.text1 Like "*" & "الاردنية" & "*" Then
    Me.text2 = "المملكة العربيه الهاشمية"

End If

باقى نعملها فى دائرة علشان تتنفذ فى كل سجل 

[سمير1404]

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

هل ممكن يكون كذا 

If Me.text1 Like "*" & "مصر" & "*" Then
    Me.text2 = text1 + "جمهورية"
ElseIf Me.text1 Like "*" & "السعودية" & "*" Then
      Me.text2 = text1 + "المملكة"

 

[عمر ضاحى]

Dim i As Integer
DoCmd.GoToRecord , , acFirst
For i = 1 To Me.Recordset.RecordCount
                    If Me.text1 Like "*" & "مصر" & "*" Then
                        Me.text2 = "جمهورية مصر العربيه"
                    ElseIf Me.text1 Like "*" & "السعودية" & "*" Then
                        Me.text2 = "المملكة العربيه السعودية"
                    
                    ElseIf Me.text1 Like "*" & "الامريكية" & "*" Then
                        Me.text2 = "الولايات المتحده الامريكيه"
                    
                    ElseIf Me.text1 Like "*" & "الاردنية" & "*" Then
                        Me.text2 = "المملكة العربيه الهاشمية"
                    
                    End If
        DoCmd.GoToRecord , , acNext
GoTo nxfor
DoCmd.GoToRecord , , acNext
nxfor:
    Next i

 

جرب هذا الحل كده

تم تعديل أبريل 26, 2022 بواسطه عمر ضاحى
تم اصلاح خطأ

[عمر ضاحى]

لقد اخطأت فى شئ وتم تداركه

الان يمكنك ان تجرب الكود

تم تعديل أبريل 26, 2022 بواسطه عمر ضاحى

[ابو جودي]

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

Function GoExt(strText As String)

Dim strExtractionWord As String: strExtractionWord = Nz(Left([strText], InStr([strText] & "", " ") - 1), strText)

Select Case strExtractionWord
    Case Is = strText: GoExt = strText
    Case Is = "مصر": GoExt = "جهورية" & " " & strText
    Case Is = "العربية": GoExt = "المملكة" & " " & strText
    Case Is = "المتحدة": GoExt = "الولايات" & " " & strText
    Case Is = "الاردنية": GoExt = "المملكة العربية" & " " & strText
End Select
End Function

يتم استدعاء الوظيفة من خلال

GoExt([text1])

ولا انصح بكتابة الأحرف العربية داخل محرر الاكود

ممكن نستخدم اليونيكود او جدول واستخدام DLookup

 ويكون التطبيق كالاتى 

 

db2_text.mdb

[عمر ضاحى]

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

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

Function GoExt(strText As String)

Dim strExtractionWord As String: strExtractionWord = Nz(Left([strText], InStr([strText] & "", " ") - 1), strText)

Select Case strExtractionWord
    Case Is = strText: GoExt = strText
    Case Is = "مصر": GoExt = "جهورية" & " " & strText
    Case Is = "العربية": GoExt = "المملكة" & " " & strText
    Case Is = "المتحدة": GoExt = "الولايات" & " " & strText
    Case Is = "الاردنية": GoExt = "المملكة العربية" & " " & strText
End Select
End Function

يتم استدعاء الوظيفة من خلال

GoExt([text1])

ولا انصح بكتابة الأحرف العربية داخل محرر الاكود

ممكن نستخدم اليونيكود او جدول واستخدام DLookup

 ويكون التطبيق كالاتى 

 

db2_text.mdb 244 kB · 1 download

انا بقول انى قدامي كثييير جدا هتعلمه منك 

ما تشرحلنا النمط ده تكسب فينا ثواب

[سمير1404]

نعم استاذ عمر تمام وهذا المراد الله يوفقك وكذلك المداخلة الكريمة من الاستاذ ابو جودي اثرت الموضوع بطريقة جدا ممتازة ومهنية وفقكم الله 

علما انه يظهر لدي خطاء في الكود استاذ عمر اعتقد لان النموذج مبني على استعلام بدون ادخال بيانات هنا الخطاء    DoCmd.GoToRecord , , acNext

[سمير1404]

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

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

استاذ ابو جودي كيف ممكن اجعل التنفيذ للوحدة النمطية من خلال زر امر لان المستخدم له الخيار في ذلك 

صراحة حاولت ولكن لم استطع 

[ابو جودي]

جرب هذا التعديل على الكود الخاص بالاستاذ @عمر ضاحى

Dim i As Integer
DoCmd.GoToRecord , , acFirst
For i = 1 To Me.Recordset.RecordCount
                    If Me.text1 Like "*" & "مصر" & "*" Then
                        Me.text2 = "جمهورية مصر العربيه"
                    ElseIf Me.text1 Like "*" & "السعودية" & "*" Then
                        Me.text2 = "المملكة العربيه السعودية"
                    
                    ElseIf Me.text1 Like "*" & "الامريكية" & "*" Then
                        Me.text2 = "الولايات المتحده الامريكيه"
                    
                    ElseIf Me.text1 Like "*" & "الاردنية" & "*" Then
                        Me.text2 = "المملكة العربيه الهاشمية"
                    
                    End If
         DoCmd.GoToRecord , , acNext
         If NewRecord Then Exit Sub
GoTo nxfor
DoCmd.GoToRecord , , acNext
nxfor:
    Next i

 

[ابو جودي]

5 دقائق مضت, سمير1404 said:

استاذ ابو جودي كيف ممكن اجعل التنفيذ للوحدة النمطية من خلال زر امر لان المستخدم له الخيار في ذلك 

صراحة حاولت ولكن لم استطع 

اتفضل 

 

db2_text (2).mdb

[سمير1404]

الله يا ابو جودي ،،،

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

صراحة انتم رجعوتني الى زمن جميل سابق في هذا الموقع 

الله يحفظكم اجمعين 

[ابو جودي]

4 ساعات مضت, عمر ضاحى said:

ما تشرحلنا النمط ده تكسب فينا ثواب

من عيونى تحت امرك 

اولا الدالة InStr هى تستخم لمعرفة موضع أول ظهور لسلسة نصية فى سلسلة نصية آخرى

وهنا لاننا نريد الكلمة الأولى والتى تبدأ بعدها مسافة سوف نعتبر ان المسافة هى المرشد الذى نستخدمه

نريد معرفة موضع المسافة الاولى فى السلسة النصية كلها

وعندما نستخدم الدالة InStr 
بهذا الشكل 

InStr([text1] & ""," ")

سوف تعيد لنا رقم موضع المسافة داخل السلسلة النصية

ثانيا الدالة Left تستخدم هذه الداله لاستخلاص جزء من الجهه اليسرى من النص 
ونمرر لها وسيطين
الوسيط الاول وهو  source  وهو النص الاصلى
الوسيط الثانى وهو length  هو طول النص الذى تريد استخلاصه من النص الاصلى من الجهه اليسرى من النص

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

فتكون الدالة بهذا الشكل 

Left([text1],8-1)

وطبعا لاننا نريد حذف المسافة اضفنا -1

وبالنسبة لباقى الكود Select Case اعتقد مفهوم 

انظر للمرفق الاتى فى الاستعلام Query1 سوف تتضح لكم الررية افضل

 

 

db2_text (3).mdb

3 ساعات مضت, سمير1404 said:

الله يا ابو جودي ،،،

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

صراحة انتم رجعوتني الى زمن جميل سابق في هذا الموقع 

الله يحفظكم اجمعين 

جزاكم الله خيرا .. 

اهلا بك 

ولكن لى وجهة نظر صغيرة لم نضع القيم مرة اخرى فى الحقل text2

بينما فكرتى الأولى توفر لك استخدما البيانات وتوفير حقل فى الجدول 

لقد وضعت لكم الفكرة تفى بالغرض وتصل بكم لمبتغاكم بطريقة مباشرة مع امكانية الاستغناء عن الحقل  text2 فى الجدول وتوفير حجم البيانات 

[عمر ضاحى]

5 ساعات مضت, ابو جودي said:

من عيونى تحت امرك 

اولا الدالة InStr هى تستخم لمعرفة موضع أول ظهور لسلسة نصية فى سلسلة نصية آخرى

وهنا لاننا نريد الكلمة الأولى والتى تبدأ بعدها مسافة سوف نعتبر ان المسافة هى المرشد الذى نستخدمه

نريد معرفة موضع المسافة الاولى فى السلسة النصية كلها

وعندما نستخدم الدالة InStr 
بهذا الشكل 

InStr([text1] & ""," ")

سوف تعيد لنا رقم موضع المسافة داخل السلسلة النصية

ثانيا الدالة Left تستخدم هذه الداله لاستخلاص جزء من الجهه اليسرى من النص 
ونمرر لها وسيطين
الوسيط الاول وهو  source  وهو النص الاصلى
الوسيط الثانى وهو length  هو طول النص الذى تريد استخلاصه من النص الاصلى من الجهه اليسرى من النص

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

فتكون الدالة بهذا الشكل 

Left([text1],8-1)

وطبعا لاننا نريد حذف المسافة اضفنا -1

وبالنسبة لباقى الكود Select Case اعتقد مفهوم 

انظر للمرفق الاتى فى الاستعلام Query1 سوف تتضح لكم الررية افضل

 

 

db2_text (3).mdb 272 kB · 3 downloads

جزاكم الله خيرا .. 

اهلا بك 

ولكن لى وجهة نظر صغيرة لم نضع القيم مرة اخرى فى الحقل text2

بينما فكرتى الأولى توفر لك استخدما البيانات وتوفير حقل فى الجدول 

لقد وضعت لكم الفكرة تفى بالغرض وتصل بكم لمبتغاكم بطريقة مباشرة مع امكانية الاستغناء عن الحقل  text2 فى الجدول وتوفير حجم البيانات 

الله يحفظك ويكرمك ويعطيك الف الف عافيه 

كود ممتاز ورائع من حضرتك 

الله يحرم وجهك عن النار

ويبارك له فى علمك ومالك وصحتك

[Moosak]

بارك الله همم الشباب وحفظكم الله .. حلول رائعة وجميلة 🙂 

ولي رأي بأن يتم إنشاء جدول يوضع فيه الكلمة المختصرة ويقابلها العبارة الكامله لها .. هكذا :

ثم يتم إنشاء وحدة نمطية تفحص وجود الكلمة في الجدول وتحضر العبارة الكاملة في مربع النص الآخر ..

بهذه الطريقة سيكون متاح للمستخدم أن يضيف إلى الجدول ما يشاء لاحقا بدون الحاجة لتعديل الوحدة النمطية كلما أرنا إضافة دولة جديدة ..

هذا كود بعد التحديث :

Private Sub text1_AfterUpdate()
Dim LookFor As String
Dim FullName As String
If IsNull(Me.text1) Then Exit Sub
LookFor = Trim(Me.text1)
FullName = DLookup("[LongName]", "[Cuntries]", "[ShortName] Like '*" & LookFor & "*'")
Me.text2 = FullName
End Sub

( إعلان : شكرا للكاتب الذكي لدوال المجال 😊 الراعي الرسمي لهذه الدالة )  

وهذه النتيجة ( قبل / بعد ) :

الملف :

db2_text.mdb

تم تعديل أبريل 27, 2022 بواسطه Moosak

[عمر ضاحى]

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

بارك الله همم الشباب وحفظكم الله .. حلول رائعة وجميلة 🙂 

ولي رأي بأن يتم إنشاء جدول يوضع فيه الكلمة المختصرة ويقابلها العبارة الكامله لها .. هكذا :

ثم يتم إنشاء وحدة نمطية تفحص وجود الكلمة في الجدول وتحضر العبارة الكاملة في مربع النص الآخر ..

بهذه الطريقة سيكون متاح للمستخدم أن يضيف إلى الجدول ما يشاء لاحقا بدون الحاجة لتعديل الوحدة النمطية كلما أرنا إضافة دولة جديدة ..

هذا كود بعد التحديث :

Private Sub text1_AfterUpdate()
Dim LookFor As String
Dim FullName As String
If IsNull(Me.text1) Then Exit Sub
LookFor = Trim(Me.text1)
FullName = DLookup("[LongName]", "[Cuntries]", "[ShortName] Like '*" & LookFor & "*'")
Me.text2 = FullName
End Sub

( إعلان : شكرا للكاتب الذكي لدوال المجال 😊 الراعي الرسمي لهذه الدالة )  

وهذه النتيجة ( قبل / بعد ) :

الملف :

db2_text.mdb 992 kB · 0 downloads

هذا ما كنت اريد عمله من البدايه 

لكن معرفتش اعملها ازاى 

فسهلتها على نفسي بدالة if & like

ثم جاء لنا استاذي @ابو جوديبتحفه اعجبتني كثيرا

ثم انت الان اتيت بالذى كان يشغل تفكيري كيف يمكن فعلها

بارك الله فيك 

وجزاك الله عنا كل خير

[ابو جودي]

3 ساعات مضت, Moosak said:

ولي رأي بأن يتم إنشاء جدول يوضع فيه الكلمة المختصرة ويقابلها العبارة الكامله لها

ولو اخدت بالك انا قلت 

14 ساعات مضت, ابو جودي said:

ولا انصح بكتابة الأحرف العربية داخل محرر الاكود

ممكن نستخدم اليونيكود او جدول واستخدام DLookup

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

تعديل بسيط بوضع الكود على زر الامر كما يريد الاستاذ @سمير1404

Dim i           As Integer
Dim LookFor     As String
Dim FullName    As String
    
    DoCmd.GoToRecord , , acFirst
    For i = 1 To Me.Recordset.RecordCount
    
    LookFor = Trim(Nz(Me.text1))
    FullName = DLookup("[LongName]", "[Cuntries]", "[ShortName] Like '*" & LookFor & "*'")
    If IsNull(Me.text1) Then: Me.text2 = vbNullString: Else Me.text2 = FullName
    DoCmd.GoToRecord , , acNext
    GoTo nxfor
    DoCmd.GoToRecord , , acNext
nxfor:
    Next i

 

 

db2_text (4).mdb

[ابو جودي]

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

1. عدم وجود بيانات دولة فى جدول Cuntries
2. حقل text1 فى جدول1 لا يحتوى على اى قيم

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

لتلاشى تلك  الاخطاء يكون الكود كالأتى 

On Error GoTo ErrorHandler

Dim i               As Integer
Dim LookFor         As String
Dim FullName        As String
Dim strErrMsgTitel  As String
Dim strMsgErrPrt1   As String

    DoCmd.GoToRecord , , acFirst
    For i = 1 To Me.Recordset.RecordCount
    
    LookFor = Trim(Nz(Me.text1))
    FullName = DLookup("[LongName]", "[Cuntries]", "[ShortName] Like '*" & LookFor & "*'")
    If IsNull(Me.text1) Then: Me.text2 = vbNullString: Else Me.text2 = FullName
    DoCmd.GoToRecord , , acNext
    GoTo nxfor
    DoCmd.GoToRecord , , acNext

nxfor:
    Next i
    
procDone:
  Exit Sub
ErrorHandler:

strErrMsgTitel = ChrW("1582") & ChrW("1591") & ChrW("1571")
strMsgErrPrt1 = ChrW("62") & ChrW("62") & ChrW("45") & ChrW("45") & ChrW("45") & ChrW("62") & ChrW("32") & ChrW("32") & ChrW("1607") & ChrW("1584") & ChrW("1607") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1583") & ChrW("1608") & ChrW("1604") & ChrW("1577") & ChrW("32") & ChrW("1594") & ChrW("1610") & ChrW("1585") & ChrW("32") & ChrW("1605") & ChrW("1583") & ChrW("1585") & ChrW("1580") & ChrW("1577") & ChrW("32") & ChrW("1576") & ChrW("1580") & ChrW("1583") & ChrW("1608") & ChrW("1604") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1583") & ChrW("1608") & ChrW("1604")
    
    Select Case Err.Number
        Case Is = 94
            MsgBox$ LookFor & " " & strMsgErrPrt1, vbCritical + vbMsgBoxRight + vbMsgBoxRtlReading, strErrMsgTitel
            FullName = vbNullString
            Resume Next
        Case Else
            MsgBox$ Err.Number & ": " & Err.Description
    End Select
Resume procDone

 

db2_text (5).mdb

[Moosak]

دائما متألق يا @ابو جودي 😊