Mouse ile tıkladığımız hücreyi renklendirmek

[Tarikkk_]

@Korhan Ayhan hocam merhaba. bu makroyu uzun zamandır kullanıyorum çok güzel fakat tablo başlıkları dolgu rengini değiştirmemize izin vermiyor sadece yazı renkleri değiştirilebiliyor. başlıkların dolgu renklerini değiştirmemize izin verecek bir ayarlama yapma şansımız olabilirmi acaba teşekkürler

 

[Korhan Ayhan]

Deneyiniz.

 

[Tarikkk_]

hocam yanlış anlatmış olabilirim başlıkların dolgu renklerini tabloya tıklayınca renklendirilmesini kastetmemiştim.
başlıkların dolgu renklerini ayrıca farklı renklere boyamak istediğimizde müsade etmiyor demek istemiştim

 

[Korhan Ayhan]

Son eklediğim dosyada tablonun başlığı sarı renk olmuyor mu?

 

[Tarikkk_]

Son eklediğim dosyada tablonun başlığı sarı renk olmuyor mu?

tablo rengiyle beraber sarı oluyor.
benim yapmayı istediğim şey ise ÜRÜN yazan hücreyi kırmızı İŞLEM yazan hücreyi mavi gibi bazı başlık hücrelerin dolgu renklerini tablodan farklı renklere boyamak

 

[Korhan Ayhan]

Deneyiniz.

 

[Tarikkk_]

harikasınız çok teşekkürlerrr

 

[Tarikkk_]

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Dim Tablo As Object, Tablo_Adi As String, Satir As Range, Sutun As Range, Hucre As Range
    If ActiveSheet.Name <> "ALIŞ-SATIŞ" _
        And ActiveSheet.Name <> "ÜRÜNLER" _
        And ActiveSheet.Name <> "RAPORLAR" _
        And ActiveSheet.Name <> "ÜRETİCİLER" _
        And ActiveSheet.Name <> "CARİLER" _
        And ActiveSheet.Name <> "ÖDEME-TAHSİLAT" _
        Then Exit Sub
    ActiveSheet.Unprotect
    On Error Resume Next

    For Each Tablo In Sh.ListObjects
        Tablo_Adi = Tablo.Name
    Next

    Sh.ListObjects(Tablo_Adi).DataBodyRange.Interior.ColorIndex = Null

    If Intersect(Target, Sh.ListObjects(Tablo_Adi).DataBodyRange) Is Nothing Then Exit Sub
    If Target.Cells.Count > 2 Then Exit Sub

    Set Satir = Intersect(Target.EntireRow, Sh.ListObjects(Tablo_Adi).DataBodyRange)
    Set Sutun = Intersect(Target.EntireColumn, Sh.ListObjects(Tablo_Adi).DataBodyRange)
    Set Hucre = Intersect(Satir, Sutun)

    Application.EnableEvents = False
    Satir.Interior.ColorIndex = 6
   'Sutun.Interior.ColorIndex = 6
    Hucre.Interior.ColorIndex = 4
    Application.EnableEvents = True
    ActiveSheet.Protect
End Sub

@Korhan Ayhan hocam merhabalar makroyu yeni öğrendiğim zamanlarda sizin yazmış olduğunuz bu makro ilk kullandığım makrolardan bir tanesiydi hala severek kullanıyorum dosyamdaki tüm tablolarda tıkladığım satırı renklendirmeye yarıyor. sütunuda renklendirebiliyoruz ama ben sadece satır için kullanıyorum. ufak bir eksiği var bir sayfada 2 tablo varsa sadece birini renklendirebiliyor. aynı sayfada birden fazla tabloyu renklendirme şansımız olabilirmi teşekkür ederim

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Dim Tablo As Object
    
    For Each Tablo In Sh.ListObjects
        With Tablo
            .Range.Interior.ColorIndex = Null
            .DataBodyRange.Interior.ColorIndex = Null
        End With
    Next
    
    Set Tablo = Target.ListObject
    
    If Tablo Is Nothing Then Exit Sub
    
    If Intersect(Target, Sh.ListObjects(Target.ListObject.Name).DataBodyRange) Is Nothing Then Exit Sub
    
    Application.EnableEvents = False

    With Sh.ListObjects(Target.ListObject.Name)
        .ListColumns(Target.Column - .DataBodyRange.Column + 1).Range.Interior.ColorIndex = 6
        .ListRows(Target.Row - .DataBodyRange.Row + 1).Range.Interior.ColorIndex = 6
         Target.Interior.ColorIndex = 15
    End With

    Application.EnableEvents = True
End Sub

 

[Tarikkk_]

Deneyiniz.

Option Explicit

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Dim Tablo As Object
  
    For Each Tablo In Sh.ListObjects
        With Tablo
            .Range.Interior.ColorIndex = Null
            .DataBodyRange.Interior.ColorIndex = Null
        End With
    Next
  
    Set Tablo = Target.ListObject
  
    If Tablo Is Nothing Then Exit Sub
  
    If Intersect(Target, Sh.ListObjects(Target.ListObject.Name).DataBodyRange) Is Nothing Then Exit Sub
  
    Application.EnableEvents = False

    With Sh.ListObjects(Target.ListObject.Name)
        .ListColumns(Target.Column - .DataBodyRange.Column + 1).Range.Interior.ColorIndex = 6
        .ListRows(Target.Row - .DataBodyRange.Row + 1).Range.Interior.ColorIndex = 6
         Target.Interior.ColorIndex = 15
    End With

    Application.EnableEvents = True
End Sub

@Korhan Ayhan hocam çok teşekkür ederim 2 ve 2 den fazla tablo olan sayfalarda çalışıyor ama benim paylaştığım makroda tablo başlıklarını yapmıyordu bu makroya göre başlıkları da renklendiriyor. başlıkları renklendirmeyi iptal etmeye çalıştım ama yapamadım. size zahmet veriyorum ama mümkünse başlıkları iptal edebilirmiyiz. şimdiden çok teşekkür ederim

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Dim Tablo As Object
    
    For Each Tablo In Sh.ListObjects
        With Tablo
            .Range.Interior.ColorIndex = Null
            .DataBodyRange.Interior.ColorIndex = Null
        End With
    Next
    
    Set Tablo = Target.ListObject
    
    If Tablo Is Nothing Then Exit Sub
    
    If Intersect(Target, Sh.ListObjects(Target.ListObject.Name).DataBodyRange) Is Nothing Then Exit Sub
    
    Application.EnableEvents = False

    With Sh.ListObjects(Target.ListObject.Name)
        Intersect(Target.EntireColumn, .DataBodyRange).Interior.ColorIndex = 6
        Intersect(Target.EntireRow, .DataBodyRange).Interior.ColorIndex = 6
        Target.Interior.ColorIndex = 4
    End With

    Application.EnableEvents = True
End Sub

 

[Tarikkk_]

Deneyiniz.

Option Explicit

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Dim Tablo As Object
   
    For Each Tablo In Sh.ListObjects
        With Tablo
            .Range.Interior.ColorIndex = Null
            .DataBodyRange.Interior.ColorIndex = Null
        End With
    Next
   
    Set Tablo = Target.ListObject
   
    If Tablo Is Nothing Then Exit Sub
   
    If Intersect(Target, Sh.ListObjects(Target.ListObject.Name).DataBodyRange) Is Nothing Then Exit Sub
   
    Application.EnableEvents = False

    With Sh.ListObjects(Target.ListObject.Name)
        Intersect(Target.EntireColumn, .DataBodyRange).Interior.ColorIndex = 6
        Intersect(Target.EntireRow, .DataBodyRange).Interior.ColorIndex = 6
        Target.Interior.ColorIndex = 4
    End With

    Application.EnableEvents = True
End Sub

çok teşekkür ederim hocam. tam istediğim gibi sorunsuz çalışıyor.

 

[Tarikkk_]

@Korhan Ayhan hocam makroda ufak bir sorun daha var sütunları en baştan sütun harfleri olan yerden seçtiğimizde tablo üstündeki ve altındaki boş satırlarda olmak üzere tüm sütunu renklendiriyor. örnek dosya attım. teşekkür ederim

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Dim Tablo As Object
   
    For Each Tablo In Sh.ListObjects
        With Tablo
            .Range.Interior.ColorIndex = Null
            .DataBodyRange.Interior.ColorIndex = Null
        End With
    Next
   
    Set Tablo = Target.ListObject
   
    If Tablo Is Nothing Then Exit Sub
   
    If Intersect(Target, Sh.ListObjects(Target.ListObject.Name).DataBodyRange) Is Nothing Then Exit Sub
   
    Application.EnableEvents = False

    With Sh.ListObjects(Target.ListObject.Name)
        Intersect(Target.EntireColumn, .DataBodyRange).Interior.ColorIndex = 6
        Intersect(Target.EntireRow, .DataBodyRange).Interior.ColorIndex = 6
        Intersect(Target, Sh.ListObjects(Target.ListObject.Name).DataBodyRange).Interior.ColorIndex = 4
    End With

    Application.EnableEvents = True
End Sub

 

[Tarikkk_]

@Korhan Ayhan hocam bu sefer gerçekten kusursuz oldu ellerinize sağlık çok teşekkür ederim. sadece sayfa düzeni tablo olduğunda mesela bir tablodaki başlığın dolgu rengini kırmızı yaptığımızda sayfadan çıkıp girdiğimizde kendiliğinden renk değiştiriyor. tablo başlık renkleri otomatik olmalı
biraz kurcaladım
.Range.Interior.ColorIndex = Null
bu kodu iptal ettiğimizde belirlediğimiz renk kalıyor ama bu kod başka bir işe yarıyormu doğrusunumu yapıyorum bilemedim.

 

[Korhan Ayhan]

Dilediğiniz gibi değiştirip kullanabilirsiniz.