Skip to main content

AccessTr.neT


Renk Koduna Göre Hücreyi Renklendirme

Renk Koduna Göre Hücreyi Renklendirme

Çözüldü #1
Merhaba,
ekli dosyadaki renk kodlarının ve yeni ekleyeceğim kodlara göre karşılarındaki hücreyi renklendirebilir miyim
Teşekkürler.
.7z renk koduna göre hücreleri renklendirme.7z (Dosya Boyutu: 6,54 KB | İndirme Sayısı: 2)
Cevapla
#2
önce çalışmanıza bir modül ekleyip aşağıdaki kodu yapıştırın
Option Compare Text

Function xRenk(ByVal Rng As Range) ' As String
If Len(Rng.Value & "") > 0 Then Rng.Offset(, 1).Interior.Color = HEXCOL2RGB(Rng.Value) Else Rng.Offset(, 1).Interior.Color = vbWhite
End Function

Public Function HEXCOL2RGB(ByVal HexColor As String) As String
Dim Red As String, Green As String, Blue As String
HexColor = Replace(HexColor, "#", "")
Red = Val("&H" & Mid(HexColor, 1, 2))
Green = Val("&H" & Mid(HexColor, 3, 2))
Blue = Val("&H" & Mid(HexColor, 5, 2))
HEXCOL2RGB = RGB(Red, Green, Blue)
End Function
sonrada ilgili sayfanın olayını aşağıdaki gibi düzenleyin
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A:A")) Is Nothing Then 'sadece B,C sütununa bakar
Application.EnableEvents = False
On Error GoTo hata
Dim cll As Range
AdrX = Target.Address & ":" & Target.Address
xDz = Split(AdrX, "$")
ilk = xDz(2)
Son = Val(xDz(4))
If ilk = "1:" Then ilk = "2:"
If Son < 2 Then Son = 2
Set Trgt = Range("A" & ilk & "A" & Son)

For Each cll In Trgt
Set Rng = cll
xRenk (Rng)
Next cll

End If
hata:
Application.EnableEvents = True
End Sub
dilerim işinize yarar
Cevapla
#3
olmadı hocam, yapamadım.
Cevapla
#4
Worksheet_Change olayını çalışması için kodları ekledikten A sütunundaki verileri silip yeniden eklemelisiniz
Cevapla
#5
BU arada dikkatimden kaçmış benim kullandığım yöntemin çalışabilmesi için dosyanızın xlsb yada xlsm gibi makro yazılabilen formatta olması gerekiyor
hücre içi formüllerden anlamam bu sorun çıkarır mı?
.rar renk koduna göre hücreleri renklendirme_hy.rar (Dosya Boyutu: 17,04 KB | İndirme Sayısı: 6)
Cevapla
#6
sayfa1 deki renk kodlarını sayfa2'ye yapıştırıp dener misiniz?
Not: Yanlış dosyayı yüklemiştim düzelttim
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da
Task