Seçili satırı renklendirme kodunu eklenti haline nasıl dönüştürebiliriz

[bilal5412]

Merhaba, aşağıdaki kodları bu forumdan buldum. Seçili olan ve aktif sayfayı satırı renklendiriyor. Bu kodu daimi çalışması için her sayfaya yapıştırmak yerine bir eklenti haline getirip tüm excel dosyalarında veya çalışma sayfalarında aktif hale getirebilir miyiz.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Application.CutCopyMode = xlCopy Or Application.CutCopyMode = xlCut Then Exit Sub
Cells.Interior.ColorIndex = xlNone
If Intersect(Target, [A1:Q50]) Is Nothing Then Exit Sub
Range(Cells(Target.Row, 1), Cells(Target.Row, 17)).Interior.ColorIndex = 28
Target.Interior.ColorIndex = 6
End Sub

 

[systran]

aşağıdaki kodları bir modül içine yazınız.

Sub renklendir(ByVal hedef As Range)
If Application.CutCopyMode = xlCopy Or Application.CutCopyMode = xlCut Then Exit Sub
Cells.Interior.ColorIndex = xlNone
If Intersect(hedef, [A1:Q50]) Is Nothing Then Exit Sub
Range(Cells(hedef.Row, 1), Cells(hedef.Row, 17)).Interior.ColorIndex = 28
hedef.Interior.ColorIndex = 6
End Sub

her çalışma sayfasının worksheet_selectionChange olayının kodları da şu şekilde olmalı.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Call renklendir(Target)
End Sub

 

[bilal5412]

aşağıdaki kodları bir modül içine yazınız.

Sub renklendir(ByVal hedef As Range)
If Application.CutCopyMode = xlCopy Or Application.CutCopyMode = xlCut Then Exit Sub
Cells.Interior.ColorIndex = xlNone
If Intersect(hedef, [A1:Q50]) Is Nothing Then Exit Sub
Range(Cells(hedef.Row, 1), Cells(hedef.Row, 17)).Interior.ColorIndex = 28
hedef.Interior.ColorIndex = 6
End Sub

her çalışma sayfasının worksheet_selectionChange olayının kodları da şu şekilde olmalı.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Call renklendir(Target)
End Sub

Tam olarak anlayamadım. Biraz daha açabilir misiniz.

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki işlemleri uygulayın.

Dosyanızı açın.
Alt+F11 ile kod penceresine ulaşın.

Buçalışmakitabı bölümüne aşağıdaki kodu uygulayın.

Dim Kitap(1) As New Class1
 
Private Sub Workbook_Open()
    Set Kitap(1).Kitap = Excel.Application
End Sub

Aynı ekranda INSERT menüsünden Class Module ekleyin ve içine aşağıdaki kodu uygulayın.

Public WithEvents Kitap As Excel.Application
 
Private Sub Kitap_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    If Application.CutCopyMode = xlCopy Or Application.CutCopyMode = xlCut Then Exit Sub
    Cells.Interior.ColorIndex = xlNone
    If Intersect(Target, [A1:Q50]) Is Nothing Then Exit Sub
    Range(Cells(Target.Row, 1), Cells(Target.Row, 17)).Interior.ColorIndex = 28
    Target.Interior.ColorIndex = 6
End Sub

Dosyanızı kayıt edip kapatın. Tekrar açıp sayfalarda hücre seçip sonucu gözlemleyin.

Dilerseniz dosyanızı farklı kaydet seçeneğinden eklenti olarak kaydedip daha sonra eklentiyi aktif ettikten sonra tüm dosyalarınızda kullanabilirsiniz.

 

[systran]

örnek dosyayı inceleyiniz.
https://drive.google.com/folderview...N2XzFCRkJxanloWmZLTWJSMGRBMjZiZjQ&usp=sharing

 

[bilal5412]

Merhaba,

Aşağıdaki işlemleri uygulayın.

Dosyanızı açın.
Alt+F11 ile kod penceresine ulaşın.

Buçalışmakitabı bölümüne aşağıdaki kodu uygulayın.

Dim Kitap(1) As New Class1
 
Private Sub Workbook_Open()
    Set Kitap(1).Kitap = Excel.Application
End Sub

Aynı ekranda INSERT menüsünden Class Module ekleyin ve içine aşağıdaki kodu uygulayın.

Public WithEvents Kitap As Excel.Application
 
Private Sub Kitap_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    If Application.CutCopyMode = xlCopy Or Application.CutCopyMode = xlCut Then Exit Sub
    Cells.Interior.ColorIndex = xlNone
    If Intersect(Target, [A1:Q50]) Is Nothing Then Exit Sub
    Range(Cells(Target.Row, 1), Cells(Target.Row, 17)).Interior.ColorIndex = 28
    Target.Interior.ColorIndex = 6
End Sub

Dosyanızı kayıt edip kapatın. Tekrar açıp sayfalarda hücre seçip sonucu gözlemleyin.

Dilerseniz dosyanızı farklı kaydet seçeneğinden eklenti olarak kaydedip daha sonra eklentiyi aktif ettikten sonra tüm dosyalarınızda kullanabilirsiniz.

Merhaba, Korhan Bey, cevabınız için çok teşekkür ederim. Yukarıdaki adımlarını izleyerek çalışmayı tamamladım.

Ekteki çalışma ile ilgili iki sorum olacak,

- Benim çalıştığım excel dosyalarında bazen 65536 satır bazende 1 milyon satırlı exceller bulunabiliyor. Ekteki satır sayısını 1 milyon olarak uyguladığım zaman 65 bin satırlı excelde hata veriyor. Bunun çözümü var mıdır

- Eski renkleri siliyor. Bunun da bir çözümü var mıdır.

Saygılar.

 

[bilal5412]

Merhaba, Korhan Bey, cevabınız için çok teşekkür ederim. Yukarıdaki adımlarını izleyerek çalışmayı tamamladım.

Ekteki çalışma ile ilgili iki sorum olacak,

- Benim çalıştığım excel dosyalarında bazen 65536 satır bazende 1 milyon satırlı exceller bulunabiliyor. Ekteki satır sayısını 1 milyon olarak uyguladığım zaman 65 bin satırlı excelde hata veriyor. Bunun çözümü var mıdır

- Eski renkleri siliyor. Bunun da bir çözümü var mıdır.

Saygılar.

Merhaba arkadaşlar, bu konuda yardımcı olabilir misiniz. (alıntıdaki kalın yazılar için)