كيفية عرض تاريخ هجري في ليبل

[أبو أمين]

السلام عليكم

هذه اول مشاركة لي في هذا المنتدى , وانا معجب كثيرا بعباقرته 

سؤالي :  هل يمكن عرض تاريخ اليوم في ليبل على يوزر فورم بهذا الشكل

الأحد 1 محرم 1437

مع الشكر

[ياسر خليل أبو البراء]

أخي الكريم دندن

أهلا بك في المنتدى ونورت بين إخوانك ونتمنى لك قضاء أمتع الأوقات مع إخوانك

يرجى تغيير اسم الظهور للغة العربية كما يرجى الإطلاع على رابط التوجيهات في الموضوعات المثبتة بالمنتدى

اطلع على الملف المرفق فيه ما تريد بإذن الله

Gregorian Hijri Dates UserForm.rar

[أبو أمين]

السلام عليكم

أشكرك أخي ياسر خليل  , هذا بالظبط ما ابحث عنه . فقط المشكلة عندي ان الشهر العربي يظهر .... بحروف غريبة .

فما الحل من فضلكم....... علما ان عندي ويدوز 10.

حاولت تغيير الإسم فلم أفلح فقط نجحت في إضافة أبو أمين  . فالمعذرة  ......  

تم تغيير الإسم بحمد الله ... بعد بحث طويل  ......

المعذرة لكم مرة أخرى 

[ياسر خليل أبو البراء]

أخي الكريم ابو أمين

ممكن ترفق شكل الصورة التي يظهر فيها الشهر العربي بحروف غريبة ...

هل جربت الملف المرفق وبه المشكلة ؟ أم أنك قمت بنقل الكود الخاص بالفورم إلى ملفك

يرجى التوضيح ..

[جعفر الطريبق]

السلام عليكم

بعد اذن الأستاذ ياسر , قم بتغيير الدالة HijriMonth كالنالي :

Function HijriMonth(MonthNumber As Integer)
    Select Case MonthNumber
        Case 1: HijriMonth = ChrW(&H645) & ChrW(&H62D) & ChrW(&H631) & ChrW(&H645)
        Case 2: HijriMonth = ChrW(&H635) & ChrW(&H641) & ChrW(&H631)
        Case 3: HijriMonth = ChrW(&H631) & ChrW(&H628) & ChrW(&H64A) & ChrW(&H639) & " " & ChrW(&H627) & ChrW(&H644) & ChrW(&H623) & ChrW(&H648) & ChrW(&H644)
        Case 4: HijriMonth = ChrW(&H631) & ChrW(&H628) & ChrW(&H64A) & ChrW(&H639) & " " & ChrW(&H627) & ChrW(&H644) & ChrW(&H62B) & ChrW(&H627) & ChrW(&H646) & ChrW(&H64A)
        Case 5: HijriMonth = ChrW(&H62C) & ChrW(&H645) & ChrW(&H627) & ChrW(&H62F) & ChrW(&H649) & " " & ChrW(&H627) & ChrW(&H644) & ChrW(&H623) & ChrW(&H648) & ChrW(&H644)
        Case 6: HijriMonth = ChrW(&H62C) & ChrW(&H645) & ChrW(&H627) & ChrW(&H62F) & ChrW(&H649) & " " & ChrW(&H627) & ChrW(&H644) & ChrW(&H62B) & ChrW(&H627) & ChrW(&H646) & ChrW(&H64A)
        Case 7: HijriMonth = ChrW(&H631) & ChrW(&H62C) & ChrW(&H628)
        Case 8: HijriMonth = ChrW(&H634) & ChrW(&H639) & ChrW(&H628) & ChrW(&H627) & ChrW(&H646)
        Case 9: HijriMonth = ChrW(&H631) & ChrW(&H645) & ChrW(&H636) & ChrW(&H627) & ChrW(&H646)
        Case 10: HijriMonth = ChrW(&H634) & ChrW(&H648) & ChrW(&H627) & ChrW(&H644)
        Case 11: HijriMonth = ChrW(&H630) & ChrW(&H648) & " " & ChrW(&H627) & ChrW(&H644) & ChrW(&H642) & ChrW(&H639) & ChrW(&H62F) & ChrW(&H629)
        Case 12: HijriMonth = ChrW(&H630) & ChrW(&H648) & " " & ChrW(&H627) & ChrW(&H644) & ChrW(&H62D) & ChrW(&H62C) & ChrW(&H629)
    End Select
End Function

 

[جعفر الطريبق]

كذالك و بنفس الطريقة يمكن اضافة يوم الأسبوع بالحروف العربية الى  Label11 كالنالي ;

1- أضف دالة جديدة و لنعطيها اسم  DayNameArabic

Function DayNameArabic(InputDate As Date)
    Dim DayNumber As Integer
    DayNumber = Weekday(InputDate, vbSunday)
    Select Case DayNumber
        Case 1
            DayNameArabic = ChrW(&H627) & ChrW(&H644) & ChrW(&H623) & ChrW(&H62D) & ChrW(&H62F)
        Case 2
            DayNameArabic = ChrW(&H627) & ChrW(&H644) & ChrW(&H625) & ChrW(&H62B) & ChrW(&H646) & ChrW(&H64A) & ChrW(&H646)
        Case 3
            DayNameArabic = ChrW(&H627) & ChrW(&H644) & ChrW(&H62B) & ChrW(&H644) & ChrW(&H62B) & ChrW(&H627) & ChrW(&H621)
        Case 4
            DayNameArabic = ChrW(&H627) & ChrW(&H644) & ChrW(&H623) & ChrW(&H631) & ChrW(&H628) & ChrW(&H639) & ChrW(&H627) & ChrW(&H621)
        Case 5
            DayNameArabic = ChrW(&H627) & ChrW(&H644) & ChrW(&H62E) & ChrW(&H645) & ChrW(&H64A) & ChrW(&H633)
        Case 6
            DayNameArabic = ChrW(&H627) & ChrW(&H644) & ChrW(&H62C) & ChrW(&H645) & ChrW(&H639) & ChrW(&H629)
        Case 7
            DayNameArabic = ChrW(&H627) & ChrW(&H644) & ChrW(&H633) & ChrW(&H628) & ChrW(&H62A)
    End Select
End Function

2- ثم عدل الكود الموجود في الفورم كالنالي ;

Private Sub UserForm_Initialize()
    Label11.Caption = Label11.Caption & " " & DayNameArabic(Now())
    Label2.Caption = DayName(Now())
    Label3.Caption = Format(Now(), "dd")
    Label4.Caption = Format(Now(), "mm")
    Label5.Caption = Format(Now(), "yyyy")
    Label6.Caption = Format(DHijri(Now()), "dd")
    Label7.Caption = HijriMonth(Format(DHijri(Now), "mm"))
    Label8.Caption = Format(DHijri(Now()), "yyyy")
End Sub

 

ملاحظة 

ربما تحتاج الى توسيع عرض ال Label11 بعض الشيء لكي يظهر كل النص

تم تعديل نوفمبر 4, 2015 بواسطه جعفر الطريبق
ملاحظة

[أبو أمين]

السلام عليكم جميعا و رحمة الله

هذه الصورة مرفقة  وهي ماخوذة من ملفك الذي ارفقته

[جعفر الطريبق]

تفضل يا أستاذ أبو أمين الملف معدل https://app.box.com/s/lp1z6e0ownqlc2yfpfwlmd7szeb71x0o

[أبو أمين]

هذه الصورة مرفقة بعد تعديل الكود حيب ما شرحه الأخ جعفر الطريبق .

فقط قفت بتعديل بسيط هنا في السطر الثالث

Private Sub UserForm_Initialize()
   Label11.Caption = Label11.Caption & " " & DayNameArabic(Now())
    Label2.Caption = DayNameArabic(Now())
    Label3.Caption = Format(Now(), "dd")
    Label4.Caption = Format(Now(), "mm")
    Label5.Caption = Format(Now(), "yyyy")
    Label6.Caption = Format(DHijri(Now()), "dd")
    Label7.Caption = HijriMonth(Format(DHijri(Now), "mm"))
    Label8.Caption = Format(DHijri(Now()), "yyyy")

End Sub

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

سأقوم في المرة القادمة بشرح برنامجي الذي أنا بصدد إتمامه والذي أدعو الله أن ينفع به مسلمي فرنسا .

 

[أبو أمين]

هذه واجهة الدخول البرنامج بعد الإستفادة من أكواد الإخوة في هذاالمنتدى الرائع

بقيت بعض الصعوبات التي سأطرحها لآحقا

مع الشكر الجزيل

[جعفر الطريبق]

واجهة جميلة

تم تعديل نوفمبر 4, 2015 بواسطه جعفر الطريبق

[عبد العزيز البسكري]

السّلام عليكم و رحمة الله و بركاته

أخي الكريم " أبو أمين " .. لو كنتَ اتبّعت التوجيهات الموضوعة بالمنتدى للأعضاء الجدد لوجدت الحل بأسرع وقت ممكن ..

راجع هذا الرّابط لو تكرمت :

http://www.officena.net/ib/topic/60047-كود-الوقت-و-التّاريخ-على-اليوزرفورم/

فائق تقديري و إحتراماتي

 

 

 

 

[ياسر خليل أبو البراء]

أخي الحبيب جعفر

دائماً ما تتحفنا بكل ما هو جديد ومفيد

ممكن إلقاء مزيد من الضوء حول ChrW وما الفائدة من استخدامها ؟ ولو فيه جدول يوضح المقابل للحروف العربية أكون لك ممتن

تقبل تحياتي

[أبو أمين]

السلام عليكم 

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

مع الشكر الجزيل.....

[abdullh307]

في 04 نوفمبر, 2015 at 10:04, أبو أمين said:

هذه الصورة مرفقة بعد تعديل الكود حيب ما شرحه الأخ جعفر الطريبق .

فقط قفت بتعديل بسيط هنا في السطر الثالث

Private Sub UserForm_Initialize()
   Label11.Caption = Label11.Caption & " " & DayNameArabic(Now())
    Label2.Caption = DayNameArabic(Now())
    Label3.Caption = Format(Now(), "dd")
    Label4.Caption = Format(Now(), "mm")
    Label5.Caption = Format(Now(), "yyyy")
    Label6.Caption = Format(DHijri(Now()), "dd")
    Label7.Caption = HijriMonth(Format(DHijri(Now), "mm"))
    Label8.Caption = Format(DHijri(Now()), "yyyy")

End Sub

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

سأقوم في المرة القادمة بشرح برنامجي الذي أنا بصدد إتمامه والذي أدعو الله أن ينفع به مسلمي فرنسا .