اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

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

KHALED SLEEM

بواسطه KHALED SLEEM
في قسم الأكسيس Access

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

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

KHALED SLEEM

KHALED SLEEM

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

هذا برنامج  يقوم بالتعويض عن الحروف بقيمها ارقام  -قاعدة iif -وهو موجود  عند حضراتكم  بإسم ابجد هوز  وقد تم بنجاح  لكنه قائم على كتابة 1 حرف فى كل خلية واقوم بجمع القيم فى خلية اخرى اريد لو اكتب فى الخلية جملة كاملة ويقوم البرنامج بحسابها وجمع القيم

 

حروف.accdb

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

محمد أبوعبدالله

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

السلام عليكم

افتح موديول جديد وضع به الكود التالي ووظيفته حذف جميع المسافات بالنص 

Function NoSpace(X3 As String) As String

Dim X5 As String
    X5 = RTrim(X3)
    Do While InStr(X5, " ") > 0
      X5 = Left(X5, InStr(X5, " ") - 1) & Mid(X5, InStr(X5, " ") + 1)
    Loop
    NoSpace = Trim(X5)
    
End Function

وفي النموذج اضف مربع نص جديد لكتابة النص به

وضع به الكود التالي في حدث عند الخروج 

On Error GoTo Err:
    If IsNull(Me.Text79) Then
        DoCmd.CancelEvent
    Else
    
        X1 = NoSpace(Me.Text79)
'        Debug.Print X1
        Me.[1].Value = Mid(X1, 1, 1)
        Me.[2].Value = Mid(X1, 2, 1)
        Me.[3].Value = Mid(X1, 3, 1)
        Me.[4].Value = Mid(X1, 4, 1)
        Me.[5].Value = Mid(X1, 5, 1)
        Me.[6].Value = Mid(X1, 6, 1)
        Me.[7].Value = Mid(X1, 7, 1)
        Me.[8].Value = Mid(X1, 8, 1)
        Me.[9].Value = Mid(X1, 9, 1)
        Me.[10].Value = Mid(X1, 10, 1)
        Me.[11].Value = Mid(X1, 11, 1)
        Me.[12].Value = Mid(X1, 12, 1)
        Me.[13].Value = Mid(X1, 13, 1)
        Me.[14].Value = Mid(X1, 14, 1)
        Me.[15].Value = Mid(X1, 15, 1)
        Me.[16].Value = Mid(X1, 16, 1)
        Me.[17].Value = Mid(X1, 17, 1)
        Me.[18].Value = Mid(X1, 18, 1)
        Me.[19].Value = Mid(X1, 19, 1)
        Me.[20].Value = Mid(X1, 20, 1)
        Me.[21].Value = Mid(X1, 21, 1)
        Me.[22].Value = Mid(X1, 22, 1)
        Me.[23].Value = Mid(X1, 23, 1)
        Me.[24].Value = Mid(X1, 24, 1)
        Me.[25].Value = Mid(X1, 25, 1)
        Me.[26].Value = Mid(X1, 26, 1)
        Me.[27].Value = Mid(X1, 27, 1)
        Me.[28].Value = Mid(X1, 28, 1)
        Me.[29].Value = Mid(X1, 29, 1)
        Me.[30].Value = Mid(X1, 30, 1)


    End If

Err:

حروف.rar

تحياتي

  • Like 3
رابط هذا التعليق
شارك
kanory

kanory

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

ايضا مشاركة مع اخي الاستاذ @محمد أبوعبدالله

تفضل ... 

Public Function CountChar() As Integer
    Dim StringToSearch As String, Character As String
    StringToSearch = Me.txtTest
    CountChar = 0
    For i = 1 To Len(StringToSearch)
         ms = Mid(StringToSearch, i, 1)
        Strr = Nz(DLookup("n", "Tbl1", "[l] = '" & ms & "'"))
        Strr2 = Strr2 + Strr
        Me.kan = Strr2
    Next i
End Function

تم استدعاء الكود ... 

Call CountChar

 

kan_1238.mdb

  • Like 6
رابط هذا التعليق
شارك
KHALED SLEEM

KHALED SLEEM

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

الاستاذ ابو خليل .. الله يجازيكم خير الجزاء .. كنت محتاج النص يقوم بالتحديث. حضرتك اخترت اجراء الحدث عند الخروج لو ينفع يكون التحديث مباشر بارك الله فى عمرك على ان يقوم بالحفظ داخل القاعدة 

 

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

 

شكرا جزيلا  الاستاذ ابو خليل . عمل جليل ربنا يبارك فى حضرتك 

شكرا جزيلا للإستاذ محمد ابو عبد الله  استفدت كثيرا من عمل حضرتك 

جزاكم الله واغناكم واعطاكم من فضله حروف.rar

kan_1238.mdb

تم تعديل بواسطه KHALED SLEEM
رابط هذا التعليق
شارك
KHALED SLEEM

KHALED SLEEM

قام بنشر
  • الكاتب
قام بنشر

السلام عليكم ورحمة الله وبركاته .. الاستاذ محمد ابو عبد الله .. لك الشكر الجزير والله انا استفدت كثيرا من ملف حضرتك وجعلته الملف الرئيسي . فى برنامجى . واستأذن حضرتك لو ان هذه البيانات التى اكتبها  ويتم حسابها فkan_1238.mdbى النموذج  . اريدها ان تحفظ فى جدول  بارك الله فى حضرتك 

رابط هذا التعليق
شارك
محمد أبوعبدالله

محمد أبوعبدالله

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

تفضل اخي الكريم 

Private Sub Form_Current()
On Error GoTo Err:
    If IsNull(Me.Text79) Then
        DoCmd.CancelEvent
    Else
    
        X1 = NoSpace(Me.Text79)
'        Debug.Print X1
        Me.[1].Value = Mid(X1, 1, 1)
        Me.[2].Value = Mid(X1, 2, 1)
        Me.[3].Value = Mid(X1, 3, 1)
        Me.[4].Value = Mid(X1, 4, 1)
        Me.[5].Value = Mid(X1, 5, 1)
        Me.[6].Value = Mid(X1, 6, 1)
        Me.[7].Value = Mid(X1, 7, 1)
        Me.[8].Value = Mid(X1, 8, 1)
        Me.[9].Value = Mid(X1, 9, 1)
        Me.[10].Value = Mid(X1, 10, 1)
        Me.[11].Value = Mid(X1, 11, 1)
        Me.[12].Value = Mid(X1, 12, 1)
        Me.[13].Value = Mid(X1, 13, 1)
        Me.[14].Value = Mid(X1, 14, 1)
        Me.[15].Value = Mid(X1, 15, 1)
        Me.[16].Value = Mid(X1, 16, 1)
        Me.[17].Value = Mid(X1, 17, 1)
        Me.[18].Value = Mid(X1, 18, 1)
        Me.[19].Value = Mid(X1, 19, 1)
        Me.[20].Value = Mid(X1, 20, 1)
        Me.[21].Value = Mid(X1, 21, 1)
        Me.[22].Value = Mid(X1, 22, 1)
        Me.[23].Value = Mid(X1, 23, 1)
        Me.[24].Value = Mid(X1, 24, 1)
        Me.[25].Value = Mid(X1, 25, 1)
        Me.[26].Value = Mid(X1, 26, 1)
        Me.[27].Value = Mid(X1, 27, 1)
        Me.[28].Value = Mid(X1, 28, 1)
        Me.[29].Value = Mid(X1, 29, 1)
        Me.[30].Value = Mid(X1, 30, 1)


    End If

Err:

End Sub

Private Sub Text79_Exit(Cancel As Integer)
    
    Call Form_Current

End Sub

حروف.rar

تحياتي

وهذه اضافة على ملف استاذنا @kanory

kan_001238.rar

تحياتي

  • Thanks 2
رابط هذا التعليق
شارك
ابوخليل

ابوخليل

قام بنشر
قام بنشر
في ٧‏/٨‏/٢٠٢١ at 12:04, KHALED SLEEM said:

الاستاذ ابو خليل .. الله يجازيكم خير الجزاء .. كنت محتاج النص يقوم بالتحديث. حضرتك اخترت اجراء الحدث عند الخروج لو ينفع يكون التحديث مباشر بارك الله فى عمرك على ان يقوم بالحفظ داخل القاعدة 

شكرا جزيلا  الاستاذ ابو خليل . عمل جليل ربنا يبارك فى حضرتك 

 

نيابة عن احبتي اقول بلسانهم كلنا ابوخليل .. واللي اخذ قلبك يتهنا به :wub:

  • Like 1
  • Haha 1
رابط هذا التعليق
شارك
أ / محمد صالح

أ / محمد صالح

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

مساهمة من العبد لله لإثراء الموضوع

تم الاستغناء عن جدول قيم الحروف

والزر في النموذج

وتم استعمال دالة بسيطة 

Public Function CharVal(SearchStr) As Long
Dim i As Long, myval As Long
If Not IsNull(SearchStr) Then
Dim d As Object: Set d = CreateObject("Scripting.Dictionary"): d.Add "أ", 1: d.Add "ب", 2: d.Add "ج", 3: d.Add "د", 4: d.Add "ه", 5: d.Add "و", 6: d.Add "ز", 7: d.Add "ح", 8: d.Add "ط", 9: d.Add "ي", 10: d.Add "ك", 20: d.Add "ل", 30: d.Add "م", 40: d.Add "ن", 50: d.Add "س", 60: d.Add "ع", 70: d.Add "ف", 80: d.Add "ص", 90: d.Add "ق", 100: d.Add "ر", 200: d.Add "ش", 300: d.Add "ت", 400: d.Add "ث", 500: d.Add "خ", 600: d.Add "ذ", 700: d.Add "ض", 800: d.Add "ظ", 900: d.Add "غ", 1000: d.Add "ا", 1: d.Add "إ", 1: d.Add "آ", 1: d.Add "ء", 1: d.Add "ى", 10: d.Add "ئ", 10: d.Add "ؤ", 6: d.Add "ة", 5: d.Add " ", 0
For i = 1 To Len(SearchStr)
myval = myval + d(Mid(SearchStr, i, 1))
Next i
End If
CharVal = myval
End Function

يتم استدعاؤها بعد تحديث مربع النص 

Private Sub text1_AfterUpdate()
Me.text3.Value = CharVal(Me.text1.Value)
End Sub

تحياتي للجميع

 

 

 

mas_charval.mdb

  • Like 4
  • Thanks 1
رابط هذا التعليق
شارك
KHALED SLEEM

KHALED SLEEM

قام بنشر
  • الكاتب
قام بنشر

السلام عليكم ورحة الله وبركاته ..  حضرتك التعديل الذي وضعته رائع  وحقق معى نتائج جميلة واصبح البرنامج خفيف للغاية.  
حضرتك انا احتجت الى ان اضيف بعض الحروف ..  استجاب البرنامج  مثلا (ى مثل ي -ؤ مثل و  -ئ مثل ي -آ-إ-أ- مثل  ا  ) وذلك فى جدول القيم.
الحرف الوحيد الذى اعطى نتيجة مختلفة هو حرف (ة) اعطى نتيجة مثل (ت)=400
مع ان قيمة  ة =5  مثل هـ  وهذه القيم مدرجة فى الجدول ولكن النتيجة بتكون 400

والله انا شاكر جدا لتعاونكم وسامحونا على الاطالة عليكم .
وجعله الله فيى ميزان حسناتكم 

kan_1238.mdb

رابط هذا التعليق
شارك
KHALED SLEEM

KHALED SLEEM

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

هذه النسخة بعد اضافة  ة  أإآ ى ئ ؤ  بقيمها فى الجدول
محتاج  اوضح لحضرتك  التشابه فى القيم 
أإآا  اى حرف منها = 1   -  ي  ى  ئ = اى حرف منها = 10  -    ة  هـ  =  تتشابه وتساوى 5 

 

kan_1238.mdb

تم تعديل بواسطه KHALED SLEEM
رابط هذا التعليق
شارك
KHALED SLEEM

KHALED SLEEM

قام بنشر
  • الكاتب
قام بنشر

الشكر الجزيل للأستاذ محمد صالح .. المعادلة صغيرة وخفيفة وسهل فهمها مش عارف اشكرك ازاي  ـ  وحقيقي الله يزيدكم جميعا من علمه وعطائه  ولا حرمكم من الجزاء 

الشكر الجزيل للأستاذ ابو خليل .. فكرة  جدول القيم رائعة يمكننا التغيير والتعديل عليها .. بارك الله فيكم وزادكم من فضله 

الشكر الجزيل للأستاذ / محمد ابو عبد الله.. على الاهتمام الكبير والصبر فى التعاون معي وفكرة التحديث على البرنامج  واضافة الكلمات الى القاعدة رائعة بارك الله فى حضرتك .

زادكم الله جميعاً من فضله وجمعكم فى الجنة بإذنه تعالى . وجزاكم عنا خير الجزاء

  • Like 1
رابط هذا التعليق
شارك
KHALED SLEEM

KHALED SLEEM

قام بنشر
  • الكاتب
قام بنشر

السلام عليكم ورحمة الله وبركاته .  الاستاذ / محمد صالح ..  طبقت القاعدة بتاعة حضرتك تمام وتسلم ايدك . وتمكنت بسهولة من اضافة بعض الاحرف بقيمها واعطت النتيجة الجميلة التى كنت اتمناها 
بارك الله فى حضرتك .. 
الان طريقة حساب الجمل لها طريقتين  من حيث القيم ..
فقمت بعمل موديل جديد بإسم جديد HOORF-BAST  وكتبت فيه القيم الجديدة .
وكذلك نموذج HOROOF-BAST وقمت ايضا بتحديد الجدول الجديد الذى يحدث فيه
وهو HOROOF-BAST-STOR 

وحاولت التطبيق لم ينجح فى القاعدتين ولم استطع المعالجة.

ياريت حضرتك تساعدنى فى ضبط الجملة البرمجية.
 

القاعدة التى تفضلت علينا بها  حضرتك تم تغيير اسماء الكائنات الى

جدول HOROOF-STOR 

  النموذج HOROOF-FORM 

الوحدة النمطية الىHOROOF  

لسهولة التداول داخل قاعدة البيانات حيث انها قاعدة تشمل العديد من العمليات غير موضوعنا هذا 
ولكم منا الشكر . ولكم من الله الأجر .

MAS_CHARVALمطلوب التعديل.accdb

  • Like 1
رابط هذا التعليق
شارك
أ / محمد صالح

أ / محمد صالح

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

المشكلة كانت في تكرار اسم الدالة في الموديولين وفي أحد النماذج وتحديد الجدول مصدر كل نموذج

تفضل هذا التعديل

MAS_CHARVAL بطريقتين.accdb

  • Thanks 1
رابط هذا التعليق
شارك

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