• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Makro kodunda revize yapma

sirkülasyon

Altın Üye
Katılım
10 Temmuz 2012
Mesajlar
2,543
Excel Vers. ve Dili
2021 LTSC TR
Kod:
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("AG2") = TextBox1
    Range("AK2") = TextBox2
    
    Range("H3:AL3") = ""
    Range("H4:AL26") = ""
    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
    Unload Me
End Sub

Hayırlı Sabahlar
Yukarıda yer alan makro kodunda yatay olarak günleri sıralıyordum.
Bu makro kodunu dikey yapmak istiyorum. A4:A35 aralığına almak istiyorum.
Yardımcı olabilir misiniz?
 
Kod:
Sutun = 8
kısmını

Kod:
Sutun = 4
ve

Kod:
Cells(3, Sutun) = Day(X)
kısmını

Kod:
Cells(Sutun,"A") = Day(X)
yapınca oluyor mu?
 
Kod:
Cells(4, Sutun) = Day(X)
Yusuf Abim
Kısmı için hata verdi ben dosyayı yükledim.
 

Ekli dosyalar

Aşağıdaki şekilde düzenleyince mevcut tablonuzda A4'ten itibaren aşağı doğru günleri listeledi (tablo şeklini düzenlemeniz gerekiyor tabi):
Kod:
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("AI2") = TextBox1
    Range("AL2") = TextBox2
    
    Range("H3:AL3") = ""
    Range("H4:AL26") = ""
    Range("H3:AL26").Interior.ColorIndex = xlNone
    
    Sutun = 4
    
    For X = Tarih_1 To Tarih_2
        If OptionButton1 Then
            If Weekday(X, vbMonday) < 6 Then
                Cells(Sutun, "A") = Day(X)
                Sutun = Sutun + 1
            End If
        ElseIf OptionButton2 Then
            Cells(Sutun, "a") = Day(X)
            If Weekday(X, vbMonday) = 6 Then Cells(Sutun, "a").Resize(24, 1).Interior.ColorIndex = 38
            If Weekday(X, vbMonday) = 7 Then Cells(Sutun, "a").Resize(24, 1).Interior.ColorIndex = 33
            Sutun = Sutun + 1
        End If
    Next
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
    Unload Me
End Sub
 
Yusuf Abim
Haftasonunu renklendirmede hata var. Kontrol edebilir misiniz?
Ellerine Sağlık. Teşekkür Ederim
 
Aşağıdaki gibi kullanın:

Kod:
            If Weekday(X, vbMonday) = 6 Then Cells(Sutun, "a").Resize(1, [B][COLOR="Red"]24[/COLOR][/B]).Interior.ColorIndex = 38
            If Weekday(X, vbMonday) = 7 Then Cells(Sutun, "a").Resize(1, [COLOR="red"][B]24[/B][/COLOR]).Interior.ColorIndex = 33

Kırmızı kısmı kaç sütun boyanacaksa ona göre değiştirin.
 
For X satırından önce aşağıdaki satırı ilave ederseniz önceki renklendirmeyi iptal eder:

Kod:
    [A4:AM34].Interior.Color = xlNone
 
Abim Benim Ellerine Sağlık.
Hakkını Helal et. Teşekkürler
 
Geri
Üst