Çizelge Hazırlama

[sirkülasyon]

Selamün Aleyküm Değerli Abilerim. Hayırlı Ramazanlar
Ekte bir çizelgem mevcut. Çizelge Hazırla butonu ile açılan userformda YIL ve AY manuel girilecek.
BİRİNCİSİ Userformda "Hafta Sonu Dahil" - "Hafta Sonu Hariç" olarak iki tane seçenek mevcut. Seçeneğe göre ve belirtilen YIL ve AY' a göre tarihler rakam girilmiş satırın hücrelerine getirilebilir mi?
İKİNCİSİ Hafta sonu dahil seçeneği seçilirse eğer Cumartesi ve Pazar Günlerinin bulunduğu sütun tablo kadar renklendirilebilir mi?

ÜÇÜNCÜSÜ Seçilen AY ve Seçilen YIL tablonun en sağında SARI olarak renklendirilmiş kısma aktarılabilir mi?

Eğer zamanınız var ise ilgilenmeniz mümkün mü?
Teşekkür Ederim.
Saygılarımla

 

[Korhan Ayhan]

Aşağıdaki kodu deneyiniz.

Private Sub CommandButton1_Click()
    If TextBox1 = "" Or Not IsNumeric(TextBox1) Then
        MsgBox "Yıl değerini giriniz!", vbCritical
        TextBox1 = ""
        TextBox1.SetFocus
        Exit Sub
    End If
    
    If TextBox2 = "" Or Not IsNumeric(TextBox2) Then
        MsgBox "Ay değerini giriniz!", vbCritical
        TextBox2 = ""
        TextBox2.SetFocus
        Exit Sub
    End If
    
    If TextBox2 < 1 Or TextBox2 > 12 Then
        MsgBox "Ay değeri için 1-12 arasında bir değer giriniz!", vbCritical
        TextBox2 = ""
        TextBox2.SetFocus
        Exit Sub
    End If

    Tarih_1 = DateSerial(TextBox1, TextBox2, 1)
    Tarih_2 = DateSerial(TextBox1, TextBox2 + 1, 0)
    
    Range("AE2") = TextBox1
    Range("AI2") = TextBox2
    
    Range("H3:AL3") = ""
    Range("H3:AL26").Interior.ColorIndex = xlNone
    
    Sutun = 8
    
    For X = Tarih_1 To Tarih_2
        If OptionButton1 Then
            If Weekday(X, vbMonday) < 6 Then
                Cells(3, Sutun) = Day(X)
                Sutun = Sutun + 1
            End If
        ElseIf OptionButton2 Then
            Cells(3, Sutun) = Day(X)
            If Weekday(X, vbMonday) = 6 Then Cells(3, Sutun).Resize(24, 1).Interior.ColorIndex = 38
            If Weekday(X, vbMonday) = 7 Then Cells(3, Sutun).Resize(24, 1).Interior.ColorIndex = 33
            Sutun = Sutun + 1
        End If
    Next
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[sirkülasyon]

Korhan Abi Teşekkür Ederim. Mükemmel Olmuş

Ellerine sağlık.