• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Aktif Hücre Renklensin

  • Konbuyu başlatan Konbuyu başlatan furens
  • Başlangıç tarihi Başlangıç tarihi
furens

furens

Katılım
24 Aralık 2007
Mesajlar
130
Excel Vers. ve Dili
2007 Tr
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.?
 
Sadece 1 Altarnatif Workbook a ekleyin
Kod: 
Private Sub Workbook_Open()
Cells.Select
Selection.Interior.ColorIndex = xlNone
Range("A1").Select
End Sub

veya bir makroya

Kod: 
Private Sub auto_Open()
Cells.Select
Selection.Interior.ColorIndex = xlNone
Range("A1").Select
End Sub
 
verdiğiniz kodların ikisinide kodun yazıldığı sayfanın altına ekledim halen aynı hatayıveriryor.Hiç bir etikisi yok
 
furens' Alıntı:
verdiğiniz kodların ikisinide kodun yazıldığı sayfanın altına ekledim halen aynı hatayıveriryor.Hiç bir etikisi yok
Genişletmek için tıkla ...
Verdiğim kodları kodun yazıldıgı sayfaya değil 1 module oluşturun ve oraya

Kod: 
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

Kod: 
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 ...
 
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
Genişletmek için tıkla ...

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
Genişletmek için tıkla ...
 
tşk.çalıştı.ancak yumarıdaki formülü düzeltme imkanı yokmuydu
 
furens' Alıntı:
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.?
Genişletmek için tıkla ...

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

Kod: 
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

Kod: 
Private Sub Workbook_Open()
Range("A1").Select
End Sub
 
halit3' Alıntı:
Biraz geç oldu ama
sayfanın kod bölümüne bu kodu ekleyiniz.

Kod: 
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

Kod: 
Private Sub Workbook_Open()
Range("A1").Select
End Sub
Genişletmek için tıkla ...

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' Alıntı:
Aşağıdaki linki inceleyiniz.

Aktif hücre-satır-sütun renklendirme
Genişletmek için tıkla ...


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.
 

Ekli dosyalar

İ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.
 
security' Alıntı:
Verdiğim kodları kodun yazıldıgı sayfaya değil 1 module oluşturun ve oraya

Kod: 
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

Kod: 
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 ...
Genişletmek için tıkla ...
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ı
 
Çü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.
 
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


Kod: 
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
 
Forumda Intersect komutunu araştırın. Bolca örnek bulabilirsiniz.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst