Komut Butonuyla Aç Kapa

[hakki83]

Selamlar

Örnek dosyada tarihleri renklendiren kodlar vardır.

Komut butonunu bir basışta çalıştıracak, diğer basışta iptal edecek hale getirebilir miyiz acaba, teşekkürler.

 

[Muzaffer Ali]

Merhaba.

Deneyiniz.

Private Sub CommandButton1_Click()
    Dim sf As Worksheet
    Dim Son As Long
    Dim Tarih(9)
    Dim Bak As Integer
    Static Renklendir As Boolean
    
    Renklendir = Not Renklendir
    Set sf = Sheets("RAPOR")
    Son = sf.Cells(Rows.Count, "A").End(3).Row
    
    For Bak = 0 To 9
        Tarih(Bak) = Date + Bak
    Next
    
    Application.ScreenUpdating = False
    sf.Range("A2:C" & Son).Interior.Color = xlNone
    If Renklendir Then Exit Sub
    sf.Range("A1:C" & Son).AutoFilter Field:=2, Operator:=xlFilterValues, Criteria1:=Tarih
    sf.Range("A2:C" & Son).SpecialCells(xlCellTypeVisible).Interior.Color = vbYellow
    sf.Range("A1:C" & Son).AutoFilter
    Application.ScreenUpdating = True
    
End Sub

 

[dEdE]

Merhaba,
Sizin koda küçük bir ek yaptım.
Sayfaya bir ToggleButton (Değiştirme Düğmesi) ekleyip, butonun kod bölümüne aşağıdaki kodu yapıştırarak dener misiniz?

Private Sub ToggleButton1_Click()
Dim sf As Worksheet: Set sf = Sheets("RAPOR")
Dim tarih1 As Date, tarih2 As Date, taranan As Date
    tarih1 = Format(Date, "dd.mm.yyyy")
    tarih2 = Format(Date + 10, "dd.mm.yyyy")
    son = sf.Cells(Rows.Count, "A").End(3).Row
  
If ToggleButton1.Value = True Then
    sf.Range("A2:C" & son).Interior.Color = xlNone
  
    For i = 2 To son
        taranan = Format(sf.Cells(i, "B").Value, "dd.mm.yyyy")
        If taranan = tarih1 Or taranan > tarih1 Then
        If taranan = tarih2 Or taranan < tarih2 Then
            sf.Range(sf.Cells(i, "A"), sf.Cells(i, "C")).Interior.Color = vbYellow
        End If
        End If
    Next i
Else
    sf.Range("A2:C" & son).Interior.Color = xlNone
End If
End Sub

 

[hakki83]

Merhaba,
Sizin koda küçük bir ek yaptım.
Sayfaya bir ToggleButton (Değiştirme Düğmesi) ekleyip, butonun kod bölümüne aşağıdaki kodu yapıştırarak dener misiniz?

Private Sub ToggleButton1_Click()
Dim sf As Worksheet: Set sf = Sheets("RAPOR")
Dim tarih1 As Date, tarih2 As Date, taranan As Date
    tarih1 = Format(Date, "dd.mm.yyyy")
    tarih2 = Format(Date + 10, "dd.mm.yyyy")
    son = sf.Cells(Rows.Count, "A").End(3).Row
 
If ToggleButton1.Value = True Then
    sf.Range("A2:C" & son).Interior.Color = xlNone
 
    For i = 2 To son
        taranan = Format(sf.Cells(i, "B").Value, "dd.mm.yyyy")
        If taranan = tarih1 Or taranan > tarih1 Then
        If taranan = tarih2 Or taranan < tarih2 Then
            sf.Range(sf.Cells(i, "A"), sf.Cells(i, "C")).Interior.Color = vbYellow
        End If
        End If
    Next i
Else
    sf.Range("A2:C" & son).Interior.Color = xlNone
End If
End Sub

Dede hocam emeğinize sağlık, çok güzel olmuş. Müsait vaktinizde biir tane de komut butonuyla yapabilirseniz, denemek isterim

 

[hakki83]

Merhaba.

Deneyiniz.

Private Sub CommandButton1_Click()
    Dim sf As Worksheet
    Dim Son As Long
    Dim Tarih(9)
    Dim Bak As Integer
    Static Renklendir As Boolean
   
    Renklendir = Not Renklendir
    Set sf = Sheets("RAPOR")
    Son = sf.Cells(Rows.Count, "A").End(3).Row
   
    For Bak = 0 To 9
        Tarih(Bak) = Date + Bak
    Next
   
    Application.ScreenUpdating = False
    sf.Range("A2:C" & Son).Interior.Color = xlNone
    If Renklendir Then Exit Sub
    sf.Range("A1:C" & Son).AutoFilter Field:=2, Operator:=xlFilterValues, Criteria1:=Tarih
    sf.Range("A2:C" & Son).SpecialCells(xlCellTypeVisible).Interior.Color = vbYellow
    sf.Range("A1:C" & Son).AutoFilter
    Application.ScreenUpdating = True
   
End Sub

Muzaffer Ali hocam emeğinize sağlık, çok güzel olmuş. Sadece 10 günü renklendirmesi gerekiyordu. Koddaki iki adet 9’u 10 yaptım düzeldi. Sanıyorum doğru yaptım.
Teşekkürler.

 

[Muzaffer Ali]

Rica ederim. Kolay gelsin.