اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

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


إذهب إلى أفضل إجابة Solved by ميدو63,

الردود الموصى بها

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

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

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

  • Like 4
  • Thanks 1
رابط هذا التعليق
شارك

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

  • Like 1
رابط هذا التعليق
شارك

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

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

 

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

وكذلك عدد ايام الشهر (بمعنة يناير 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

 

  • Like 3
رابط هذا التعليق
شارك

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

 

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

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

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

رابط هذا التعليق
شارك

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

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

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

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

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

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

تم تعديل بواسطه مختار حسين محمود
  • Thanks 1
رابط هذا التعليق
شارك

  • 1 year later...

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information