Seçili Hücreyi Renklendirme

[emre67z]

Arkadaşlar Merhaba,

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Cells.Interior.ColorIndex = xlColorIndexNone
ActiveCell.EntireRow.Interior.ColorIndex = 15 ' Satır Rengi
ActiveCell.Cells.Interior.ColorIndex = 35 ' Hücre Rengi


End Sub


İle seçili olan satırı ve hücreyi renklendiriyorum ama şöyle bir sorunla karşılaştım.
İstediğim farklı bir hücre grubunu seçip dolgu rengi yapınca izin vermiyor. Bunu nasıl yapabilirim. Hem renklendirme olsun hemde kendim el ile manuel seçebileyim. Şimdiden teşekkürler zaman ayıran herkese.

 

[Cengiz Demir]

- Sayfaya toggle buton koyup onun açık veya kapalı olması durumunu kontrol ederek kodları işleme alabilirsiniz.
- Sayfada işlem yapmadığınız bir alandaki bir hücre değerini kontrol ederek kodları işleme alabilirsiniz.

Örn.
İf Range("F1")="x" then
.....
.......
End if


Benim ilk olarak aklıma gelenler bunlar. Belki daha pratik öneriler gelebilir.

 

[polis-53]

İŞİNİZİ GÖRÜR HERALDE

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim Sütun As String, Satır As Long, Adres As String
    
    On Error GoTo Son
    
    If Kontrol = True Then
        With Application
            .ScreenUpdating = False
            .EnableEvents = False
                Sütun = Split(Selection.Address(1, 0), "$")(0)
                Adres = Sütun & ":" & Sütun
                Satır = Split(Selection.Address(1, 0), "$")(1)
                Adres = Adres & "," & Satır & ":" & Satır & "," & Selection.Address
                Range(Adres).Select
                Target.Activate
            .EnableEvents = True
            .ScreenUpdating = True
        End With
    End If
Son: Application.EnableEvents = True
End Sub

 

[polis-53]

SAYFANIN KOD BÖLÜMÜNE AŞAĞIDAKİ KODU YAZIN

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim Sütun As String, Satır As Long, Adres As String
   
    On Error GoTo Son
   
    If Kontrol = True Then
        With Application
            .ScreenUpdating = False
            .EnableEvents = False
                Sütun = Split(Selection.Address(1, 0), "$")(0)
                Adres = Sütun & ":" & Sütun
                Satır = Split(Selection.Address(1, 0), "$")(1)
                Adres = Adres & "," & Satır & ":" & Satır & "," & Selection.Address
                Range(Adres).Select
                Target.Activate
            .EnableEvents = True
            .ScreenUpdating = True
        End With
    End If
Son: Application.EnableEvents = True
End Sub

BİR MÖDÜL EKLEYEREK AŞAĞIDAKİ KODU YAZIN

Option Explicit
Public Kontrol As Boolean

Sub Renklendirme_Aktif()
Application.EnableEvents = True
Kontrol = True
End Sub

Sub Renklendirme_Pasif()
Application.EnableEvents = True
Kontrol = False
End Sub

 

[emre67z]

BİR MÖDÜL EKLEYEREK AŞAĞIDAKİ KODU YAZIN

Option Explicit
Public Kontrol As Boolean

Sub Renklendirme_Aktif()
Application.EnableEvents = True
Kontrol = True
End Sub

Sub Renklendirme_Pasif()
Application.EnableEvents = True
Kontrol = False
End Sub

Teşekkürler şimdi gördüm. Ekledim çalıştı çok teşekkürler. Ben sütünu silip öyle kullanacam sanırım olmaz diye düşünüyordum şaşırdım gerçekten sağ olun zaman ayırdığınız için

 

[emre67z]

Ne yaptıysam sütun kısmını kaldıramadım satırı kaldırıyorum ama sütun tek başına kaldıramıyorum. Sütun üzerine kurulu bir çalışma mı anlamadım ? Sadece Satırı seçebilecek şekilde yapabilir miyiz ? Hangi kısmı çıkarmam lazım

 

[polis-53]

BU KODU DENEYİN:
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
    Const Sutun As Long = 256
    Const Satir_Rengi As Long = 36
   
    Static Alan As Range
    Static Eski_Renkler(1 To Sutun) As Long
   
    If Not Alan Is Nothing Then
        With Alan.Cells
            If .Row = ActiveCell.Row Then Exit Sub
            For X = 1 To Sutun
                .Item(X).Interior.ColorIndex = Eski_Renkler(X)
            Next
        End With
    End If
   
    Set Alan = Cells(ActiveCell.Row, 1).Resize(1, Sutun)
    With Alan
        For X = 1 To Sutun
            Eski_Renkler(X) = .Item(X).Interior.ColorIndex
        Next
        .Interior.ColorIndex = Satir_Rengi
    End With
End Sub