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

KHALED SLEEM · أغسطس 6, 2021

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

حروف.accdb

تم تعديل أغسطس 6, 2021 بواسطه ابوخليل
تعديل العنوان .. يرجى الالتزام بقواعد المشاركة

**محمد أبوعبدالله** · أغسطس 6, 2021

السلام عليكم

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

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

تحياتي

**kanory** · أغسطس 6, 2021

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

تفضل ...

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

KHALED SLEEM · أغسطس 7, 2021

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

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

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

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

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

kan_1238.mdb

تم تعديل أغسطس 7, 2021 بواسطه KHALED SLEEM

KHALED SLEEM · أغسطس 9, 2021

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

**محمد أبوعبدالله** · أغسطس 9, 2021

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

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

تحياتي

KHALED SLEEM · أغسطس 9, 2021

والله انا عاجز عن الشكر. ربنا يبارك فيكم ويعطيكم افضل مما يعطى السائلين من فضله

**ابوخليل** · أغسطس 9, 2021

في ٧‏/٨‏/٢٠٢١ at 12:04, KHALED SLEEM said:

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

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

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

**أ / محمد صالح** · أغسطس 9, 2021

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

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

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

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

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

**د.كاف يار** · أغسطس 10, 2021

انت معلم و احنا منك نتعلم مشاء الله عليك لست استاذ و لكنك استاذ و رئيس قسم و عميد

**أ / محمد صالح** · أغسطس 10, 2021

بعض ما عندكم صديقي 👍😍🌹

KHALED SLEEM · أغسطس 12, 2021

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

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

kan_1238.mdb

KHALED SLEEM · أغسطس 13, 2021

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

kan_1238.mdb

تم تعديل أغسطس 13, 2021 بواسطه KHALED SLEEM

KHALED SLEEM · أغسطس 13, 2021

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

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

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

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

KHALED SLEEM · أغسطس 14, 2021

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

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

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

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

جدول HOROOF-STOR

النموذج HOROOF-FORM

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

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

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

**أ / محمد صالح** · أغسطس 14, 2021

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

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

MAS_CHARVAL بطريقتين.accdb

KHALED SLEEM · أغسطس 16, 2021

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

تسجيل الدخول

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

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

KHALED SLEEM

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

kanory

KHALED SLEEM

KHALED SLEEM

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

KHALED SLEEM

ابوخليل

أ / محمد صالح

د.كاف يار

أ / محمد صالح

KHALED SLEEM

KHALED SLEEM

KHALED SLEEM

KHALED SLEEM

أ / محمد صالح

KHALED SLEEM

Join the conversation

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

تصفح الموقع

تصفح جديد الموقع

Support

Important Information