Aktif Hücre Renklensin

[furens]

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Static EskiHucre As Range
If Target.Interior.ColorIndex <> xlColorIndexNone Then
EskiHucre.Interior.ColorIndex = xlColorIndexNone
Exit Sub
ElseIf Not EskiHucre Is Nothing Then
EskiHucre.Interior.ColorIndex = xlColorIndexNone
End If
Target.Interior.ColorIndex = 37
Set EskiHucre = Target
End Sub


Yukarıdaki kodu sitedeki son kod arşivinden aldım,çalışıyor ancak sayfayı kapatıp açtığım zaman imleç nerede kaldı ise o hücrenin rengi sabit nasıldüzeltilebilir.?

 

[security]

Sadece 1 Altarnatif Workbook a ekleyin

Private Sub Workbook_Open()
Cells.Select
Selection.Interior.ColorIndex = xlNone
Range("A1").Select
End Sub

veya bir makroya

Private Sub auto_Open()
Cells.Select
Selection.Interior.ColorIndex = xlNone
Range("A1").Select
End Sub

 

[furens]

verdiğiniz kodların ikisinide kodun yazıldığı sayfanın altına ekledim halen aynı hatayıveriryor.Hiç bir etikisi yok

 

[security]

verdiğiniz kodların ikisinide kodun yazıldığı sayfanın altına ekledim halen aynı hatayıveriryor.Hiç bir etikisi yok

Verdiğim kodları kodun yazıldıgı sayfaya değil 1 module oluşturun ve oraya

Private Sub auto_Open()
Cells.Select
Selection.Interior.ColorIndex = xlNone
Range("A1").Select
End Sub

ekleyin...
onu yapamıyorsanız ...
ThisWorkbook kod bölümüne

Private Sub Workbook_Open()
Cells.Select
Selection.Interior.ColorIndex = xlNone
Range("A1").Select
End Sub

kodunu ekleyin eski kodların altına değil ok...
yinede yapamassanız örnek dosya ekleyin ...

 

[halit3]

bunu denermisiniz.

sayfa için

Const iInternational As Integer = Not (0)
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim iColor As Integer
On Error Resume Next
iColor = Target.Interior.ColorIndex
If iColor < 0 Then
iColor = 37
Else
iColor = iColor + 1
End If
If iColor = Target.Font.ColorIndex Then iColor = iColor + 1
Cells.FormatConditions.Delete
With Cells(Target.Row, Target.Column)
.FormatConditions.Add Type:=2, Formula1:=iInternational
.FormatConditions(1).Interior.ColorIndex = iColor
End With
With Range(Target.Offset(1 - Target.Row, 0).Address & ":" & Target.Offset(-1, 0).Address)
.FormatConditions.Add Type:=2, Formula1:=iInternational

End With
End Sub

kitab için ThisWorkbook konacak

Const iInternational As Integer = Not (0)
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Dim iColor As Integer
On Error Resume Next
iColor = Target.Interior.ColorIndex
If iColor < 0 Then
iColor = 37
Else
iColor = iColor + 1
End If
If iColor = Target.Font.ColorIndex Then iColor = iColor + 1
Cells.FormatConditions.Delete
With Cells(Target.Row, Target.Column)
.FormatConditions.Add Type:=2, Formula1:=iInternational
.FormatConditions(1).Interior.ColorIndex = iColor
End With
With Range(Target.Offset(1 - Target.Row, 0).Address & ":" & Target.Offset(-1, 0).Address)
.FormatConditions.Add Type:=2, Formula1:=iInternational

End With
End Sub

 

[furens]

tşk.çalıştı.ancak yumarıdaki formülü düzeltme imkanı yokmuydu

 

[furens]

tşk çalışıyor.

 

[halit3]

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Static EskiHucre As Range
If Target.Interior.ColorIndex <> xlColorIndexNone Then
EskiHucre.Interior.ColorIndex = xlColorIndexNone
Exit Sub
ElseIf Not EskiHucre Is Nothing Then
EskiHucre.Interior.ColorIndex = xlColorIndexNone
End If
Target.Interior.ColorIndex = 37
Set EskiHucre = Target
End Sub


Yukarıdaki kodu sitedeki son kod arşivinden aldım,çalışıyor ancak sayfayı kapatıp açtığım zaman imleç nerede kaldı ise o hücrenin rengi sabit nasıldüzeltilebilir.?

Biraz geç oldu ama
sayfanın kod bölümüne bu kodu ekleyiniz.

Dim Renk
Dim Renk2
Private Sub Worksheet_Activate()
Range("A1").Select
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Renk = Empty Then
Renk = "A1"
End If
Range(Renk).Interior.ColorIndex = xlNone
Range(Renk).Interior.ColorIndex = Renk2
Dim iColor As Integer
On Error Resume Next
iColor = Target.Interior.ColorIndex
If iColor < 0 Then
iColor = 6
Else
iColor = iColor + 1
End If
If iColor = Target.Font.ColorIndex Then iColor = iColor + 1
Renk2 = Target.Interior.ColorIndex
Target.Interior.ColorIndex = xlNone
Target.Interior.ColorIndex = iColor
Renk = Target.Address
End Sub

ThisWorkbook da bu kodu ekleyin

Private Sub Workbook_Open()
Range("A1").Select
End Sub

 

[walabi]

Biraz geç oldu ama
sayfanın kod bölümüne bu kodu ekleyiniz.

Dim Renk
Dim Renk2
Private Sub Worksheet_Activate()
Range("A1").Select
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Renk = Empty Then
Renk = "A1"
End If
Range(Renk).Interior.ColorIndex = xlNone
Range(Renk).Interior.ColorIndex = Renk2
Dim iColor As Integer
On Error Resume Next
iColor = Target.Interior.ColorIndex
If iColor < 0 Then
iColor = 6
Else
iColor = iColor + 1
End If
If iColor = Target.Font.ColorIndex Then iColor = iColor + 1
Renk2 = Target.Interior.ColorIndex
Target.Interior.ColorIndex = xlNone
Target.Interior.ColorIndex = iColor
Renk = Target.Address
End Sub

ThisWorkbook da bu kodu ekleyin

Private Sub Workbook_Open()
Range("A1").Select
End Sub

Halit Bey merhaba,

Yukarda bahsedilen olayı her açtığım excel kitabında , her çalışma sayfasında kullanmak için ne yapmak gerekir.

 

[Korhan Ayhan]

Aşağıdaki linki inceleyiniz.

Aktif hücre-satır-sütun renklendirme

 

[walabi]

Aşağıdaki linki inceleyiniz.

Aktif hücre-satır-sütun renklendirme

Korhan Bey,

İlgili linklere kabaca göz attım ve ekte gördüğüm xlam dosyasını ekledim. Ancak eklentiler kısmından aktif ettiğimde her yeni excel kitabı açmamda bir hata vermekte. Linkleri belirtmenizdeki amaç ilgili dosyayı excel eklentisi olarak kaydettirmekmiydi ya da excel eklentisinin nasıl yapılabileceğini göstererekten Halit Beyin verdiği kodları xlam olarak mı kaydetmmei istediniz tam anlamadım.

Ekte görünen dosya bende hata veriyor, excel versiyonundan olabilir mi, ikinci olarak da Halit beyin yazdığı kodların biri sayfaya biri modüle. Bildiğim kadarı ile modüle eklenen kodlar xlam olarak çalışmakta. Sayfaya yazılan kodları nasıl modüle geçirmemiz gerek , bunu sormuştum.

 

[Korhan Ayhan]

Nerde hata veriyor?

 

[walabi]

İlgili kodu eklentilerden tekrardan aktif ettim. Bir excel kitabı açtığımda aldığım hata sonucu " Sheets("Sayfa1").Select "


Run-time error'1004':
Method 'Sheets' of object '_Global' failed

şeklinde hata veriyor ve debug dediğimde Sheets("Sayfa1").Select görünüyor.

 

[muyat]

Verdiğim kodları kodun yazıldıgı sayfaya değil 1 module oluşturun ve oraya

Private Sub auto_Open()
Cells.Select
Selection.Interior.ColorIndex = xlNone
Range("A1").Select
End Sub

ekleyin...
onu yapamıyorsanız ...
ThisWorkbook kod bölümüne

Private Sub Workbook_Open()
Cells.Select
Selection.Interior.ColorIndex = xlNone
Range("A1").Select
End Sub

kodunu ekleyin eski kodların altına değil ok...
yinede yapamassanız örnek dosya ekleyin ...

Konuyla ilgili olarak sormak istiyorum
Yukardaki kodları neden ilk mesajdaki kodun altına yapıştırdıgımız zaman çalışmıyor da neden ayrı bir modüle yazıyoruz.
Sonuçta makro çalışınca imleç o satıra aynı sayfada ugramıcak mı

 

[Korhan Ayhan]

Çünkü ilk mesajdaki kod SAYFA olayı kodudur.

Sizin bahsettiğiniz kodun AUTO_OPEN olanı modül kodudur.

WORKBOOK_OPEN ise kitaba ait bir olayın kodudur.

 

[muyat]

Peki o zaman şunu sorayım...
Aşagıdaki kod aktif hücreyi renklendiriyor.
Ama benım istedigim şu;
1.ve 2. satırlardaki herhangi bir hücreye tıkladıgımda o hücrenin orjınal rengini bozmasın.Çünkü 1. satırda ana başlık varken,2.satırda alt başlıklar var..
Düzeltebilir misiniz

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Static EskiHucre As Range
If Target.Interior.ColorIndex <> xlColorIndexNone Then
EskiHucre.Interior.ColorIndex = xlColorIndexNone
Exit Sub
ElseIf Not EskiHucre Is Nothing Then
EskiHucre.Interior.ColorIndex = xlColorIndexNone
End If
Target.Interior.ColorIndex = 26
Set EskiHucre = Target
End Sub

 

[Korhan Ayhan]

Forumda Intersect komutunu araştırın. Bolca örnek bulabilirsiniz.