عرض السنة و الاشهر

[محمد عدنان]

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

تقبل الله صياكم 

ارجو المساعدة بماكرو يقوم عند اختيار السنة  من الخلية l1 يقوم بنعبئة التاريخ في  الخلية c5   و c4   اليوم  من بداية العام  الى اخره 

مثال اذا تم اختيار السنة 2023   يقوم بتعبئة من 1/1/2023 ,  لغاية نهاية السنة 31/12/2023

و عتد اختيار الشهر  من الخلية L2  يقوم باظهار  اعمدة الشهر  المختار و اخفاء جميع الاشهر الاخري  

و جزاكم الله كل خير 

absss.xlsm

[lionheart]

What's the expected result in cells C4 and C5

[محمد عدنان]

السلام عليكم 

اخ @lionheart  الخلية C4   اليوم مثل السبت الاحد ...... 

                      و c5     التاريخ  مثل 1/1/2023  >>2/1/2023  3/1/2023 >>>>  الى نهاية السنة 31/12/2023

  و الخلية  l2 تقوم بعرض الشهر و اخفاء الاشهر الاخرى 

[lionheart]

But it is not practical to put the year cell and the month cell in L1 & L2 as these columns will be hidden if you select January

I suggest you rebuild the strucutre of the file so as to get the year cell and the month cell away from column C to colum NC

 

[محمد عدنان]

لتكن الخلايا فوق اسم الطالب    B1   B2

تم تعديل مارس 28, 2023 بواسطه محمد عدنان

[lionheart]

Suppose the cells are B1 & B2 for the year and the month, try the following code in worksheet change event

Private Sub Worksheet_Change(ByVal Target As Range)
    Const FirstRow As Long = 4, FirstColumn As Long = 3, numColumns As Long = 366, sColTarget As String = "C:ND"
    Dim results(1 To 2, 1 To numColumns), yearValue As Long, currentDate As Date, lastDate As Date, i As Long, selectedMonth As Long, col As Long
    If Target.Address = "$B$1" Then
        If Target.Value = Empty Then Columns(sColTarget).Rows(FirstRow & ":" & FirstRow + 1).ClearContents: GoTo Skipper
        On Error Resume Next
            yearValue = CInt(Target.Value)
        On Error GoTo 0
        If IsDate("01/01/" & yearValue) Then
            currentDate = DateSerial(yearValue, 1, 1)
            lastDate = DateSerial(yearValue + 1, 1, 1) - 1
            i = 0
            While currentDate <= lastDate
                i = i + 1
                results(1, i) = Format(currentDate, "ddd")
                results(2, i) = Format(currentDate, "yyyy-mm-dd")
                currentDate = currentDate + 1
            Wend
            Application.EnableEvents = False
            Application.ScreenUpdating = False
                Range(Cells(FirstRow, FirstColumn), Cells(FirstRow + 1, FirstColumn + i - 1)).Value = results
            Application.ScreenUpdating = True
            Application.EnableEvents = True
        Else
            MsgBox "Please Enter Valid Year", vbExclamation
        End If
    ElseIf Target.Address = "$B$2" Then
        If Target.Value = Empty Then GoTo Skipper
        On Error Resume Next
            selectedMonth = Left(Target.Value, InStr(Target.Value, ".") - 1)
        On Error GoTo 0
        If selectedMonth <> 0 Then
            Application.EnableEvents = False
            Application.ScreenUpdating = False
                Columns(sColTarget).Hidden = True
                For col = FirstColumn To numColumns + (FirstColumn - 1)
                    If IsDate(Cells(FirstRow + 1, col).Value) Then
                        If Month(Cells(FirstRow + 1, col).Value) = selectedMonth Then Cells(FirstRow + 1, col).EntireColumn.Hidden = False
                    End If
                Next col
            Application.ScreenUpdating = True
            Application.EnableEvents = True
        End If
    End If
    Exit Sub
Skipper:
    Application.EnableEvents = False
        Columns(sColTarget).Hidden = False
    Application.EnableEvents = True
End Sub

 

[محمد عدنان]

بارك الله فيك اخ @lionheart   و جزاك الله كل خير 

هل بلامكان من خلال الكود  يظلل يوم الجمعة و السبت و جزاك الله كل خير في ميزان حسناتك 

[lionheart]

 

Try the last point by yourself

You can use conditional formatting to do that task

تم تعديل مارس 28, 2023 بواسطه lionheart

[محمد عدنان]

اخ @lionheart ظهرت مشكلة عند استبدال السنة 2023  ب سنة 2024  يظهر فرقية  في شهر 12

[lionheart]

Change thi line

If Target.Value = Empty Then Columns(sColTarget).Rows(FirstRow & ":" & FirstRow + 1).ClearContents: GoTo Skipper

To be

Columns(sColTarget).Rows(FirstRow & ":" & FirstRow + 1).ClearContents: GoTo Skipper

 

[محمد عدنان]

السلام عليكم 

اخ @lionheart  ما الفرق بين السطرين  سوى حذف جملة IF لم يعمل الكود 

بارك الله فيك

[lionheart]

Sorry

Use the line without this part

: GoTo Skipper

The line should be

Columns(sColTarget).Rows(FirstRow & ":" & FirstRow + 1).ClearContents

You have to be able to fix such issues by yourself

[محمد عدنان]

بارك الله بك  اخ @lionheart  في ميزان حستاتك

[lionheart]

I think you specified the wrong reply as the best answer. This is not useful for other members

تم تعديل مارس 29, 2023 بواسطه lionheart

[محمد عدنان]

السلام عليكم 

اعتذر اخ @lionheart وبارك الله بجهدك و جزاك الله الجنة