برنامج القمر في اي برج

[mmm83]

السلام عليكم ايها الاخوة الاكرام

الموضوع يتعلق بالفلك

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

مثال

اليوم باهجري هو 11 من صفر

نضربه * 2 ونضيف له 5 .... = 27

نرى تاريخ اليوم وهو 20/9 ويقابله برج العذراء حسب البروج الشمسية 

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

ثم نضيف 5 دائما الى البرج الذي يليه وهكذا الى ان نصل هنا الى العدد 25 بالاعتماد على هذا المثال على ان لايتجاوز العدد 27

ونختار البرج المقابل وحسب الشرح في الملف المرفق ..تحياتي لكل الاخوة

المطلوب هو اظهار النتيجة بمجرد كتابة التاريخ بالهجري هذه المرحلة الاولى والمرحلة الثانية هي ان الناتج يتغير اوتماتيك بتغير التاريخ

 

القمر في اي برج.xlsx

[lionheart]

Can you give us the exact dates for each zodiac sign as you did for Virgo (which is from 23 Aug to 22 Sept)

https://en.wikipedia.org/wiki/Astrological_sign

And is that Vrigo starts at 23 Aug and included and ends at 22 Sept and included. I mean if we need to compare a date then we say greater than or equal 23 Aug and less than or equal to 22 Sept

Can you review this udf that returns the zodiac for each date

Function ZodiacSign(myDate As Date) As String
    Dim yr As Integer
    yr = Year(myDate)
    Select Case myDate
        Case Is >= CDate("12/22/" & yr), Is <= CDate("1/19/" & yr)
            ZodiacSign = "Capricorn"
        Case Is <= CDate("2/18/" & yr)
            ZodiacSign = "Aquarius"
        Case Is <= CDate("3/20/" & yr)
            ZodiacSign = "Pisces"
        Case Is <= CDate("4/19/" & yr)
            ZodiacSign = "Aries"
        Case Is <= CDate("5/20/" & yr)
            ZodiacSign = "Taurus"
        Case Is <= CDate("6/21/" & yr)
            ZodiacSign = "Gemini"
        Case Is <= CDate("7/22/" & yr)
            ZodiacSign = "Cancer"
        Case Is <= CDate("8/22/" & yr)
            ZodiacSign = "Leo"
        Case Is <= CDate("9/22/" & yr)
            ZodiacSign = "Virgo"
        Case Is <= CDate("10/22/" & yr)
            ZodiacSign = "Libra"
        Case Is <= CDate("11/22/" & yr)
            ZodiacSign = "Scorpio"
        Case Is <= CDate("12/21/" & yr)
            ZodiacSign = "Sagittarius"
    End Select
End Function

 

[mmm83]

شكرا جزيلا استاذنا لكن لطفا ارجو منكم طريقة التنفيذ بشكل ملف او شرح لاني هنا اقف بارك الله فيكم

[lionheart]

Press Alt + F11 then from VBE menu select Insert then Module then paste the code posted 

And to use the function, suppose you have a date in cell A1, put the following formula in B1

=ZodiacSign(A1)

 

[mmm83]

جزيل الشكر والامتنان لكم استاذ نفذت المطلوب وظهر عبارة virgo كما في الملف المرفق 

القمر في اي برج.xlsm

[lionheart]

Sub Test()
    Dim a, x, d, zod As String, r As Integer, q As Integer, m As Integer, p As Integer
    zod = ZodiacSign(Date)
    Rem d = Day(ToHijri(Date))
    d = Application.InputBox(prompt:="Enter The Day", Type:=1)
    If d = False Or d < 0 Then MsgBox "Invalid Entry", vbExclamation: Exit Sub
    r = (d * 2) + 5
    a = Array("Aries", "Taurus", "Gemini", "Cancer", "Leo", "Virgo", "Libra", "Scorpio", "Sagittarius", "Capricorn", "Aquarius", "Pisces")
    x = Application.Match(zod, a, 0)
    q = Int(r / 5)
    m = r Mod 5
    p = (x + q + IIf(m > 0, 1, 0)) - 2
    MsgBox "Moon In '" & a(p Mod (UBound(a) + 1)) & "' Zodiac At Degree [" & m * 6 & "]", vbInformation
End Sub

Function ZodiacSign(myDate As Date) As String
    Dim yr As Integer
    yr = Year(myDate)
    Select Case myDate
        Case Is >= CDate("12/22/" & yr), Is <= CDate("1/19/" & yr)
            ZodiacSign = "Capricorn"
        Case Is <= CDate("2/18/" & yr)
            ZodiacSign = "Aquarius"
        Case Is <= CDate("3/20/" & yr)
            ZodiacSign = "Pisces"
        Case Is <= CDate("4/19/" & yr)
            ZodiacSign = "Aries"
        Case Is <= CDate("5/20/" & yr)
            ZodiacSign = "Taurus"
        Case Is <= CDate("6/20/" & yr)
            ZodiacSign = "Gemini"
        Case Is <= CDate("7/22/" & yr)
            ZodiacSign = "Cancer"
        Case Is <= CDate("8/22/" & yr)
            ZodiacSign = "Leo"
        Case Is <= CDate("9/22/" & yr)
            ZodiacSign = "Virgo"
        Case Is <= CDate("10/23/" & yr)
            ZodiacSign = "Libra"
        Case Is <= CDate("11/21/" & yr)
            ZodiacSign = "Scorpio"
        Case Is <= CDate("12/21/" & yr)
            ZodiacSign = "Sagittarius"
    End Select
End Function

Function ToHijri(dtGegDate As Date) As String
    VBA.Calendar = vbCalHijri
    ToHijri = dtGegDate
    VBA.Calendar = vbCalGreg
End Function

 

[mmm83]

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

[lionheart]

Did you try the code with different days and returned the results as expected for you

[أبوعيد]

حل اخر بالمعادلات

القمر في البرج1.xlsx

[mmm83]

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

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

اليوم الهجري :- 16

16 * 2 + 5 = 37

37 / 5 = 7 ... والباقي 2 

ناتج القسمة وهو هنا = 7 معناه اننا يجب ان نضيف 7     ابراج  الى البرج الشمسي الحالي اي برج الميزان لان اليوم 24/9 وهو يوم من ضمن ايام برج الميزان

توجد ملاحظتان 

الملاحظة 1 :- الاضافة تكون عبارة عن العدد 5 وتكون من برج الميزان حسب مثالنا هذا

الملاحظة 2 :- عندما يكون هنالك باقي يفسر على انه خطوة اضافية اخرى اي بمعنى انه لدينا الان ناتج قسمة 37/5 = 7 هنا 7 اضافات والباقي ايضا يعتبر اضافة فيكون عدد الاضافات 7+1=8

الان نحل المثال 

قلنا ان البرج الشمسي هو الميزان سوف يكون نقطة البداية 

اليوم 16 من صفر

16* 2  + 5  = 37 

نبدا نضيف 5 لكل برج ابتداء من الميزان على ان لايتجاوز  محموع الاضافات العدد 37

الميزان = 5

العقرب = 5

القوس = 5

الجدي = 5

الدلو  = 5

الحوت = 5

الحمل  = 5  هنا اصبح مجموع الاضافات 35 ...لكن العدد الرئيسي هو 37 ..اذن باقي 2 ..هذا الباقي سوف يعامل معاملة 5 وعليه نضيف خطوة اخرى وكما في ادناه

الثور     = 2

ويكون الناتج ان ..... القمر في برج الثور في الدرجة 12

كما واحب ان اكرر شكري للاخ الاستاذ lionheart على مجهوده الرائع الذي بذله معنا واحييه على هذه النفس الطيبة وفقكم الله جميعا

 

[lionheart]

Th example you posted is the same result when I entered the day 16 in the inputbox

Can you explain what's the wrong exactly

[mmm83]

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

[lionheart]

May be attaching the file solves the problem

Zodiac Signs.xlsm

[mmm83]

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