تقييم الموضوع :
  • 0 أصوات - بمعدل 0
  • 1
  • 2
  • 3
  • 4
  • 5
مساعدة لتغيير الاحرف الى ارقام
#1
السلام عليكم اخواني الاعزاء اريد تحويل الاحرف الابجديه لكلمة بالتكست 1 الى ارقام مثلا (امجد) الابجدية الالف 1 الباء 2 الجيم3 الدال 4 ....... الى الياء 28 فتخرج امجد بالتكست 2 (1-13-3-4) او تجمع القيمة وتوضع في التكست 2 مع فائق تقديري لكم وشكرا جزيلا
الرد }}}
تم الشكر بواسطة:
#2
السلام عليكم ورحمة الله وبركاته اخواني الاعزاء صارلي اسبوع منتظر اجابة معقولة لا أحد يساعد الا بطلب اغاثة لكم موضوعي السابق اللي عند حل لا يقصر ومشكورين
الرد }}}
تم الشكر بواسطة:
#3
السلام عليكم...

1. ضع على الـ Form 3 مربعات نص (Text1 و Text2 و Text3) و زر أمر (Command1).
2. انسخ الكود التالي:
كود :
Private ArabLetters As String
Private Hamzat As String

Private Sub Command1_Click()
    Dim Idx As Long
    Dim MyText As String
    Dim ALetter As String
    Dim APos As Long
    Dim AResult As String
    Dim ASum As Long
    
    Text2.Text = ""
    Text3.Text = "0"
    AResult = ""
    ASum = 0
    
    MyText = Trim(Text1.Text)
    If MyText = "" Then Exit Sub
    
    For Idx = 1 To Len(MyText)
        ALetter = Mid$(MyText, Idx, 1)
        APos = InStr(Hamzat, ALetter)
        If APos = 0 Then
            If AResult <> "" Then AResult = AResult & " - "
            APos = InStr(ArabLetters, ALetter)
            If APos = 0 Then
                AResult = AResult & "¿"
            Else
                AResult = AResult & CStr(APos)
                ASum = ASum + APos
            End If
        Else
            If AResult <> "" Then AResult = AResult & " - "
            AResult = AResult & "1"
            ASum = ASum + 1
        End If
    Next Idx
    
    Text2.Text = AResult
    Text3.Text = CStr(ASum)
End Sub

Private Sub Form_Load()
    Hamzat = "ءاأإؤئ"
    ArabLetters = "أبجدهوزحطيكلمنسعفصقرشتثخذضظغ"
End Sub

3. شغل البرنامج و اكتب الكلمة في Text1 ثم انقر الزر. ستظهر الأرقام المقابلة للحروف في Text2 و مجموع قيمها في Text3.

* الكود يستعمل الترتيب الأبجدي (أبجد هوز حطي... إلخ.) و ليس الترتيب الألفبائي (أ.ب.ت.ث. ... إلخ)، و طبعاً يمكنك تغيير ذلك.
* الكود يتجاهل أي رمز آخر غير الحروف العربية، بما في ذلك الفراغات، و يضع بدل قيمتها علامة استفهام.
* الكود يعتبر الألف و جميع أشكال الهمزة حرفاً واحداً (نفس القيمة = 1).

4. نرجو الاستفادة و السلام.
بِسْمِ اللهِ الرَّحْمَنِ الرَّحِيمِ ( وَ مَا تُقَدِّمُوا لِأَنفُسِكُم مِّنْ خَيْرٍ تَجِدُوهُ عِندَ اللهِ هُوَ خَيْراً وَ أَعْظَمَ أَجْراً ) صَدَقَ اللهُ الْعَظِيمُ
الرد }}}
تم الشكر بواسطة:
#4
بارك الله فيك أخي الكريم فعلا كود جامد جدا .

ولكن أود أن أطلب منك شرح للدوال المستخدمة.

وفعلا جربته أيضا علي الأحرف الأنجليزية وأشتغل بشكل جيد جدا.
الرد }}}
تم الشكر بواسطة:
#5
السلام عليكم...

ما يغلى عليك غالي، أخي عبدالله الصافي (و بقية الإخوة طبعاً Big Grin)...

أولاً وضعت الهمزات في نص (String) مستقل لأن الهمزة تأخذ أشكالاً مختلفة ( ء أ إ ؤ ئ ا ) حسب موقعها و حركتها.

الدوال:
الدالة Trim: تأخذ نصاً (String) و تعيد نسخة منه بعد إزالة الفراغات السابقة (Leading spaces) و الفراغات اللاحقة (Trailing spaces) الفراغات السابقة هي التي توجد قبل أول حرف أو رمز في الـ String و الفراغات اللاحقة هي التي توجد بعد آخر حرف أو رمز في النص. وطبعاً هذه الدالة لا تحذف الفراغات الموجودة داخل النص (بين الكلمات و الحروف أو الرموز).

الدالة Mid: تعمل على إرجاع جزء من النص (String) مع تحديد بدابة الجزء المطلوب و طوله. صيغتها العامة كالتالي:
كود :
X = Mid$(AString, Start, Length)
حيث:
= AString: هو النص الذي نريد الحصول على جزء منه.
= Start: رقم الحرف أو الرمز الذي نريد أن يبدأ الجزء منه. أول حرف أو رمز في النص رقمه 1.
= Length: طول الجزء الذي نريد الحصول عليه. هذا البارامتر اختياري، أي يمكن عدم تحديده، و في هذه الحالة تعيد الدالة جزءاً يمتد من الحرف أو الرمز الذي رقمه Start إلى نهاية النص.

مثلاً:
كود :
MyStr = "بسم الله الرحمن الرحيم"
X = Mid(MyStr, 10, 6)
MsgBox X
الرسالة ستعرض كلمة "الرحمن" لأن ألف كلمة "الرحمن" في اليسملة رقمه (أو ترتيبه) 10، و طول كلمة "الرحمن" 6 أحرف.

الدالة InStr: تتأكد من وجود نص ضمن نص آخر. إذا وجدت النص المطلوب فإنها تعيد موقع أول تواجد له، و إذا لم تجده تعيد صفراً (0). و صيغتها العامة كالتالي:
كود :
N = InStr(AString1, AString2)
حيث:
= AString1: النص الذي نبحث فيه.
= AString2: النص الذي نبحث عنه.

مثلاً:
كود :
J = InStr("محمد رسول الله صلى الله عليه و سلم و لا رسول بعده", "رسول")
ستكون قيمة J هي 6 و هو موقع حرف الراء في كلمة "رسول" ضمن الجملة. لاحظ أن كلمة "رسول" مكررة مرتين، لكن الدالة InStr تعيد موقع أول تواجد للنص المطلوب (هناك صيغة أخرى للدالة تسمح لنا بتحديد موقع بداية البحثـ و بالتالي يمكننا استعمالها لإيجاد عدد تكرارات كلمة أو عبارة ضمن النص).

الدالة CStr: تعمل على تحويل قيمة عددية إلى String.

* ملاحظة: لعلك لاحظت أن بعض الدوال تكتب مع الرمز $ أو من غيره، مثل:
كود :
Mid و Mid$
Trim و Trim$
هذه كلها دوال للتعامل مع النصوص (Strings) و لا فرق في وظيفتها بين استعمال الرمز $ و عدم استعماله، لكن عند استعمال هذا الرمز فإن الدالة تعيد قيمة من النوع String أما عند عدم استعماله فإنها تعيد قيمة من النوع Variant. عادة يكون استعمال النوع Variant أبطأ قليلاً من استعمال الأنواع الصريحة مثل String أو Integer ... إلخ.

* الدالة الأخيرة: نرجو الاستفادة و السلام!
بِسْمِ اللهِ الرَّحْمَنِ الرَّحِيمِ ( وَ مَا تُقَدِّمُوا لِأَنفُسِكُم مِّنْ خَيْرٍ تَجِدُوهُ عِندَ اللهِ هُوَ خَيْراً وَ أَعْظَمَ أَجْراً ) صَدَقَ اللهُ الْعَظِيمُ
الرد }}}
تم الشكر بواسطة:
#6
والله لا أعلم ماذا أقول لك , غير ما قاله رسول الله صلي الله عليه وسلم.

بارك الله فيك وجعله في ميزان حسناتك.
ونرجو من الأخوة الكرام عند وضع كود جديد أن يقوم بعمل شرح بسيط له حتي نتمكن من إستخدامه بشكل صحيح في مشاريع أخري.
الرد }}}
تم الشكر بواسطة:
#7
السلام عليكم شكرا جزيلا اخي العزيز ناجي على الكود الرائع كنت في امس الحاجة له جزاك الله خيرا
الرد }}}
تم الشكر بواسطة:
#8
[COLOR="#FF0000"]جزاك الله خير اخ ناجي ولو قد اكون اثقلت عيك الموضوع لكن اذا كانت الابجدية قيمها كالاتي
ا=1 ب=2 ج=3 د=4 ه=5 و=6 ز=7 ح=8 ط=9 ي=10 ك=20 ل=30 م=40 ن=50 س=60 ع=70 ف=80 ص=90 ق=100 ر=200 ش=300 ت=400 ث=500 خ=600 ذ=700 ض=800 ظ=900 غ=1000 هل لعمل لها مصفوفة وكيف ربطها بالكود السابق وشكرا لك مع فائق احترامي
[/COLOR]
الرد }}}
تم الشكر بواسطة:
#9
بهلوان كتب :[COLOR="#FF0000"]جزاك الله خير اخ ناجي ولو قد اكون اثقلت عيك الموضوع لكن اذا كانت الابجدية قيمها كالاتي
ا=1 ب=2 ج=3 د=4 ه=5 و=6 ز=7 ح=8 ط=9 ي=10 ك=20 ل=30 م=40 ن=50 س=60 ع=70 ف=80 ص=90 ق=100 ر=200 ش=300 ت=400 ث=500 خ=600 ذ=700 ض=800 ظ=900 غ=1000 هل لعمل لها مصفوفة وكيف ربطها بالكود السابق وشكرا لك مع فائق احترامي
[/COLOR]

طلبك إن شاء الله كما تريد بالمرفقات


الملفات المرفقة
.zip   abdallaalsafy.zip (الحجم : 1.66 ك ب / التحميلات : 107)
الرد }}}
تم الشكر بواسطة:
#10
السلام عليكم...

الشكر للأخ عبد الله الصافي على الحل، و يمكن اختصاره باستعمال جملة Select Case مع الكود الأصلي:
كود :
Private ArabLetters As String
Private Hamzat As String

Private Sub Command1_Click()
    Dim Idx As Long
    Dim MyText As String
    Dim ALetter As String
    Dim APos As Long
    Dim AResult As String
    Dim ASum As Long
    
    Text2.Text = ""
    Text3.Text = "0"
    AResult = ""
    ASum = 0
    
    MyText = Trim(Text1.Text)
    If MyText = "" Then Exit Sub
    
    For Idx = 1 To Len(MyText)
        ALetter = Mid$(MyText, Idx, 1)
        APos = InStr(Hamzat, ALetter)
        If APos = 0 Then
            If AResult <> "" Then AResult = AResult & " - "
            APos = InStr(ArabLetters, ALetter)
            [color=#FF0000]Select Case[/color] APos
                Case 0
                    AResult = AResult & "؟"
                Case Is > 18
                    AResult = AResult & CStr((APos - 18) * 100)
                    ASum = ASum + (APos - 18) * 100
                Case Is > 9
                    AResult = AResult & CStr((APos - 9) * 10)
                    ASum = ASum + (APos - 9) * 10
                Case Else
                    AResult = AResult & CStr(APos)
                    ASum = ASum + APos
            [color=#FF0000]End Select[/color]
        Else
            If AResult <> "" Then AResult = AResult & " - "
            AResult = AResult & "1"
            ASum = ASum + 1
        End If
    Next Idx
    
    Text2.Text = AResult
    Text3.Text = CStr(ASum)
End Sub

Private Sub Form_Load()
    Hamzat = "ءاأإؤئ"
    ArabLetters = "أبجدهوزحطيكلمنسعفصقرشتثخذضظغ"
End Sub

نرجو الاستفادة و السلام.
بِسْمِ اللهِ الرَّحْمَنِ الرَّحِيمِ ( وَ مَا تُقَدِّمُوا لِأَنفُسِكُم مِّنْ خَيْرٍ تَجِدُوهُ عِندَ اللهِ هُوَ خَيْراً وَ أَعْظَمَ أَجْراً ) صَدَقَ اللهُ الْعَظِيمُ
الرد }}}
تم الشكر بواسطة:



التنقل السريع :


يقوم بقرائة الموضوع: بالاضافة الى ( 1 ) ضيف كريم