İmleç hangi hücredeyse o hücre renklensin.

[sedat2161]

Merhaba arkadaşlar. İyi çalışmalar diliyorum.
Forumda bu konu ile çok soru ve çözümler vardı. Ama bir türlü kendime göre uyarlama yapamadım yardımlarınızı bekliyorum.
Puantaj dosyamda imleç neredeyse o hücrenin herhangi bir renk ile belirlenmesi. Renkli hücreler ve biçimlendirmeler bozulmaması gerekiyor. İyi çalışmalar diliyorum.

 

[Seyit Tiken]

Farklı bir yöntem ile yaptım, işe yarasa kullanırsınız. Ok tuşlarıyla test ediniz.

 

[sedat2161]

Farklı bir yöntem ile yaptım, işe yarasa kullanırsınız. Ok tuşlarıyla test ediniz.

Sayın seyit bey ilginiz için teşekkür ederim. Dosyayı açtım ekrandaki gibi sorun veriyor.
İ

 

[Seyit Tiken]

Bende bu hatayı verdi, sizin kodlar arasındaki uyumsuzluktan kaynaklanıyor olabilir.

 

[sedat2161]

Bende bu hatayı verdi, sizin kodlar arasındaki uyumsuzluktan kaynaklanıyor olabilir.
Ekli dosyayı görüntüle 216275

Bu dosya üzerinde bakabilirmisiniz

 

[Seyit Tiken]

İlk dosya üzerinde denedim, yazdığım kodlar çalışıyor, tasarımı siz inşa ettiğiniz için olası sebebini araştırıp bulursunuz diye düşünüyorum.

 

[sedat2161]

İlk dosya üzerinde denedim, yazdığım kodlar çalışıyor, tasarımı siz inşa ettiğiniz için olası sebebini araştırıp bulursunuz diye düşünüyorum.

Hocam maalesef yapamıyorum. Olmuyor.

 

[çıtır]

Sayfa kodu olarak kopyalayarak aşağıdaki kodu denermisiniz?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("A1:BA1000")) Is Nothing Then
    Cells.FormatConditions.Delete
    Exit Sub
End If
    Cells.FormatConditions.Delete
    With ActiveCell
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:=1
        .FormatConditions(1).Font.Bold = True
        .FormatConditions(1).Interior.ColorIndex = 43
    End With
On Error GoTo Son
With [a1:Ba1000]
    Cells.Font.Size = 10
    Cells.Font.Italic = False
End With
If Intersect(Target, [a1:Ba1000]) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
If Not IsEmpty(Target) Then
Target.Font.Size = 20
Target.Font.Italic = True
End If
Son:
Application.ScreenUpdating = True
End Sub

 

[Seyit Tiken]

En son yüklediğiniz dosya üzerinde denedim, hata vermedi.

 

[sedat2161]

En son yüklediğiniz dosya üzerinde denedim, hata vermedi.

Seyit hocam herhalde sorun bende. Evdeki bilgisayar ayarlarından olabilir mi. Yarın iş yerine gittiğimde orada bakarım. İlginiz için çok teşekkür ederim. iyi çalışmalar diliyorum.

 

[sedat2161]

Sayfa kodu olarak kopyalayarak aşağıdaki kodu denermisiniz?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("A1:BA1000")) Is Nothing Then
    Cells.FormatConditions.Delete
    Exit Sub
End If
    Cells.FormatConditions.Delete
    With ActiveCell
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:=1
        .FormatConditions(1).Font.Bold = True
        .FormatConditions(1).Interior.ColorIndex = 43
    End With
On Error GoTo Son
With [a1:Ba1000]
    Cells.Font.Size = 10
    Cells.Font.Italic = False
End With
If Intersect(Target, [a1:Ba1000]) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
If Not IsEmpty(Target) Then
Target.Font.Size = 20
Target.Font.Italic = True
End If
Son:
Application.ScreenUpdating = True
End Sub

Merhaba hocam. Hocam kodu denedim. Hücreye tıklayınca renkli geliyor yalnız hücredeki değer çok büyük oluyor. ayrıca koşullu biçimlendirmeler hepsi silindi.

 

[Seyit Tiken]

Kodu biraz geliştirdik, aktif hücrenin dolgu renginin saydamlığı için kırmızı çizginin kenarına, dolguyu kaldırmak için de üzerini tıklayın.

 

[sedat2161]

Kodu biraz geliştirdik, aktif hücrenin dolgu renginin saydamlığı için kırmızı çizginin kenarına, dolguyu kaldırmak için de üzerini tıklayın.

İlk açtığımda 1. resim başka hücreye tıkladığımda 2. resim hata veriyor

 

[incsoft]

İlk açtığımda 1. resim başka hücreye tıkladığımda 2. resim hata veriyor
Ekli dosyayı görüntüle 216295Ekli dosyayı görüntüle 216296

bende de aynı hatayı verdi