السلام عليكم و رحمة الله و بركاتة نعاود معكم اللقاء بهذا البرنامج الظريف فكرة الابراج في هذا البرنامج للتسلية و الحساب اكثر من الاقتناع بفكرة التنجيم ذاتها و اتمنى من الاجميع الاستفادة ... و الان سوف نقوم معا ببناء البرنامج : 1 - قم بفتح مشروع جديد و اكتب في قسم التعاريف المتغيرات التالية Dim s1, s2, ss1, ss2 As String Dim i, m1, sum, sum1 As Integer Dim res As String 2 - قم بوضع زر كوماند و ليكن اسمه command1 و اكتب في حدث النقر التالي 'إدخال الاسماء s1 = InputBox("أدخل أسمك ...", "برنامج أعرف برجك - محمد الحمادي") If s1 = "" Then Exit Sub s2 = InputBox("أدخل أسم امك ...", "برنامج أعرف برجك - محمد الحمادي") If s2 = "" Then Exit Sub 'تجميع قيم الحروف sum = 0 For i = 1 To Len(s1) sum = sum + reve(Mid(s1, i, 1)) Next i For i = 1 To Len(s2) sum = sum + reve(Mid(s2, i, 1)) Next i 'فحص البرج sum1 = Int(sum / 12) sum1 = sum1 * 12 sum1 = sum - sum1 res = chek(sum1) 'النتيجة النهائية ss = " مبروك برجك هو " + res MsgBox ss, vbOKOnly, "برنامج أعرف برجك - محمد الحمادي .." شرح الكود : في البداية سيطلب من المستخدم ادخال اسمة و كذلك اسم امه ( حوارزمية التنجيم كذا ) و بعد ذلك سيتم حساب قيم مجموع الحروف من الدالة التي سوف نقوم ببناءها في موديول خاص حسب ترقيم الحروف ابجد هوز حطي كلمن ....... و بعدها يتم تقسيم الناتج على 12 و معرفة كم الفارق بالصحيح الفارق هو الذي يدل على البرج حيث ان 1 يعني الحمل 2 الثور ..... و هكذا 3 - في موديول اكتب دوال التحويل التالية : Public Function reve(st As String) As Integer Select Case st Case "ا": reve = 1 Case "ب": reve = 2 Case "ج": reve = 3 Case "د": reve = 4 Case "ه": reve = 5 Case "و": reve = 6 Case "ز": reve = 7 Case "ح": reve = 8 Case "ط": reve = 9 Case "ي": reve = 10 Case "ك": reve = 20 Case "ل": reve = 30 Case "م": reve = 40 Case "ن": reve = 50 Case "س": reve = 60 Case "ع": reve = 70 Case "ف": reve = 80 Case "ص": reve = 90 Case "ق": reve = 100 Case "ر": reve = 200 Case "ش": reve = 300 Case "ت": reve = 400 Case "ث": reve = 500 Case "خ": reve = 600 Case "ذ": reve = 700 Case "ض": reve = 800 Case "ظ": reve = 900 Case "غ": reve = 1000 End Select End Function Public Function chek(m As Integer) As String Select Case m Case 1: chek = "الحمل" Case 2: chek = "الثور" Case 3: chek = "الجوزاء" Case 4: chek = "السرطان" Case 5: chek = "الأسـد" Case 6: chek = "العذراء" Case 7: chek = "الميزان" Case 8: chek = "العقرب" Case 9: chek = "القوس" Case 10: chek = "الجدي" Case 11: chek = "الدلو" Case 12: chek = "الحوت" End Select End Function و كما هو واضح ان هذة الدوال من اجل اجراء عملية التحويل للحروف و كذلك للأبراج .. -*-*-*-*-*-*-*-*-*-* اتمنى ان تكون الفكرة و الدرس واضحة . تحياتي

و مرفق الكود في المرفقات تحياتي

يعطيك العافية اخوى

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

المشاركة الأصلية كتبت بواسطة عبير يعطيك العافية اخوى العفو و اتمنى الاستفادة للجميع تحياتي

المشاركة الأصلية كتبت بواسطة ياسر اليافعي مشكور اخي على البرنامج والفكره الرائعه العفو اخي ياسر تحياتي