كود انشاء الشيت باسماء اشهر السنه اوتوماتكياً

[علي حيدر]

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

اللغة الانكلزية

Sub DoMonths()
    Dim J As Integer
    Dim K As Integer
    Dim sMo(12) As String

    sMo(1) = "January"
    sMo(2) = "February"
    sMo(3) = "March"
    sMo(4) = "April"
    sMo(5) = "May"
    sMo(6) = "June"
    sMo(7) = "July"
    sMo(8) = "August"
    sMo(9) = "September"
    sMo(10) = "October"
    sMo(11) = "November"
    sMo(12) = "December"

    For J = 1 To 12
        If J <= Sheets.Count Then
            If Left(Sheets(J).Name, 5) = "Sheet" Then
                Sheets(J).Name = sMo(J)
            Else
                Sheets.Add.Move after:=Sheets(Sheets.Count)
                ActiveSheet.Name = sMo(J)
            End If
        Else
            Sheets.Add.Move after:=Sheets(Sheets.Count)
            ActiveSheet.Name = sMo(J)
        End If
    Next J

    For J = 1 To 12
        If Sheets(J).Name <> sMo(J) Then
            For K = J + 1 To Sheets.Count
                If Sheets(K).Name = sMo(J) Then
                    Sheets(K).Move Before:=Sheets(J)
                End If
            Next K
        End If
    Next J

    Sheets(1).Activate
End Sub

مختلف اللغات

Sub DoMonths()
    Dim J As Integer
    Dim K As Integer

    For J = 1 To 12
        If J <= Sheets.Count Then
            If Left(Sheets(J).Name, 5) = "Sheet" Then
                Sheets(J).Name = MonthName(J)
            Else
                Sheets.Add.Move after:=Sheets(Sheets.Count)
                ActiveSheet.Name = MonthName(J)
            End If
        Else
            Sheets.Add.Move after:=Sheets(Sheets.Count)
            ActiveSheet.Name = MonthName(J)
        End If
    Next J

    For J = 1 To 12
        If Sheets(J).Name <> MonthName(J) Then
            For K = J + 1 To Sheets.Count
                If Sheets(K).Name = MonthName(J) Then
                    Sheets(K).Move Before:=Sheets(J)
                End If
            Next K
        End If
    Next J

    Sheets(1).Activate
End Sub

 

الملفات مرفقة

اوراق الاشهر بلغة الانكليزية.rar

اوراق الاشهر بلغة جهازك.rar

[ياسر العربى]

مشكور اخي الكريم على حيدر   على الكود الرائع

جزيت خيرا

تقبل تحياتي

[علي حيدر]

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

[مجيد02]

السلام عليكم  

شكرا

 

[ميدو63]

الاخ / على حيدر

الكود جميل اشكرك عليه

 

ممكن ترشدنى او اردت تغييرة الى  أيام الاسبوع

وكذلك عدد ايام الشهر (بمعنة يناير 2016 = 31 يوم & فبرلير 2016 = 29 يوم .........وهكذا حسب الشهر والسنة)

[سليم حاصبيا]

اثراء للموضوع هذا الكود

Sub InsertSheet()
Dim arr()
arr = Array("كانون الثّاني", "شباط", "آذار", "نيسان", "أيّـار", "حزيران", "تـمّوز", "آب", "أيلول", "تشرين الأوّل", "تشرين الثّاني", "كانون الأوّل")
For i = 0 To UBound(arr)
On Error Resume Next
If Len(Sheets(arr(i)).Name) = 0 Then
Sheets.Add.Name = arr(i)
End If
 Next
End Sub

 

[علي حيدر]

اخي ميدو شكرا للمرور بالنسبه الى أيام الأسبوع لك المرفق

 

اما السؤال الثاني لم افهمه لانه يعتمد اسم الشهر لا التاريخ ممكن ان يكون ينانر2016 لا اليوم  حسب ما فهمت تقبل تحياتي

اوراق الاسبوع.rar

وتبقى أستاذ الكل اخي سليم حاصبيا شكرا للكود والمشاركة تقبل تحياتي

[مختار حسين محمود]

الاخ على حيدر مشكور على اسهاماتك والكود الجميل

الاخ ميدو  الكود التالى ينتج أوراق عمل بعدد أيام الشهر

مع مراعاة عدد أيام فبراير فى السنة البسيطة والكبيسة

مع مراعاة عدد أيام باقى الشهور 30  أم 31 يوما

كما ان اسم الورقة عبارة عن           ولا أقولك  حمل المرفق وشوف

اوراق عمل بعدد ايام االشهر الذى تحدده.rar

تم تعديل سبتمبر 23, 2016 بواسطه مختار حسين محمود

[علي حيدر]

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

[ميدو63]

اشكرك وان تأخرت فى شكرك