• DİKKAT

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

Hücre Biçimini Eski Haline Döndürmek

  • Konbuyu başlatan Konbuyu başlatan betoncu
  • Başlangıç tarihi Başlangıç tarihi
B

betoncu

Katılım
1 Aralık 2005
Mesajlar
376
Excel Vers. ve Dili
EXCEL 2002
TÜRKÇE
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo Son
With [C2:C20]
Cells.Interior.ColorIndex = xlNone
Cells.Font.Size = 10
Cells.Font.ColorIndex = 0
Cells.Font.Italic = False
End With
If Intersect(Target, [C2:C20]) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
If Not IsEmpty(Target) Then
Target.Interior.ColorIndex = 8
Target.Font.Size = 16
Target.Font.ColorIndex = 3
Target.Font.Italic = True
End If
Son:
Application.ScreenUpdating = True
End Sub


Yukarıdaki kod sayesinde; C2-C20 arasındaki hücrelere tıklayınca hücre rengi turkuaz, yazı boyutu 16 ve yazı rengi kalın oluyor.
Bu aralığın dışında başka bir hücreye tıklandığında ise hücre yazı boyutu 10 oluyor ve hücrede doldu rengi ise olmuyor.

Soruma gelecek olursak:

C2-C20 aralığının dışında başka bir hücreye tıklandığında hücrenin eski haline gelmesini (manuel olarak C2-C20 arasında hücrede dolgu rengi, yazı boyutu, yazı tipi, yazı rengi vs. hangisi seçilmişse geri o hücre biçimine dönmesini) nasıl sağlarız?
 

Ekli dosyalar

Hangi hücrelere benzeyecekse o hücre(ler)i seçin ve biçim boyacısına tıklayın daha sonra asıl hücrelerinizi seçin; böylece iki grup hücrenin biçimi birbirine benzeyecektir.
 
C2 ile C20 arasındaki biçimler değişken olarak düzenlenmekte. Dediğinizin dışında makro ile eski haline dönemez mi?
 
Merhaba,

Kullandığınız kod "C2:C20" hücre aralığını kontrol ediyorsa aşağıdaki kod bloğunda sorun var.

Kırmızı renkli bölüm bütün hücreleri kapsıyor. Bence gerek yok. Kırmızı bölümleri silip deneyin.

Kod: 
With [C2:C20]
[COLOR=red]Cells[/COLOR].Interior.ColorIndex = xlNone
[COLOR=red]Cells[/COLOR].Font.Size = 10
[COLOR=red]Cells[/COLOR].Font.ColorIndex = 0
[COLOR=red]Cells[/COLOR].Font.Italic = False
End With
 
Korhan Ayhan' Alıntı:
Merhaba,

Kullandığınız kod "C2:C20" hücre aralığını kontrol ediyorsa aşağıdaki kod bloğunda sorun var.

Kırmızı renkli bölüm bütün hücreleri kapsıyor. Bence gerek yok. Kırmızı bölümleri silip deneyin.

Kod: 
With [C2:C20]
[COLOR=red]Cells[/COLOR].Interior.ColorIndex = xlNone
[COLOR=red]Cells[/COLOR].Font.Size = 10
[COLOR=red]Cells[/COLOR].Font.ColorIndex = 0
[COLOR=red]Cells[/COLOR].Font.Italic = False
End With
Genişletmek için tıkla ...

Kırmızıları silmek istediğim çözümü vermiyor. Benim istediğim xxxxx hücresine tıklamadan önce o hücrenin rengi neyse xxxxx hücresine tıkladıktan sonra başka bir hücreye tıkladığımızda xxxxx hücresinin eski haline (xxxxx hücresine tıklamadan önceki renk, boyut vs.) dönmesini nasıl sağlarız?
 
Korhan bey umarım derdimi anlatabilmişimdir. Yardımlarınızı bekliyorum...
 
Merhaba,

Biçimler diziye alınarak çözüm bulunabilir. Fakat çoklu hücre seçimlerinizde yavaşlama sorunu yaşarsınız. Ben tavsiye etmiyorum.

İstediğiniz yönde bir uygulama aşağıdaki linkteki #7 nolu mesajda örnekle yapılmış. İnceleyiniz.

aktif hücrenin bulunduğu satır renklensin

Belki aşağıdaki yöntem daha hızlı sonuç verebilir...

Sayfanızın orjinal bir kopyasını boş bir sayfaya aktarırsınız.

Her hücre seçiminizde ilk önce orjinal yapı kopyalanır. Sonra seçtiğiniz alanda istediğiniz biçimlendirme yapılır. Böylece daha hızlı işlem yapılabilir. Tabiki emin değilim. Denemek lazım...
 
Korhan Ayhan' Alıntı:
Merhaba,

Biçimler diziye alınarak çözüm bulunabilir. Fakat çoklu hücre seçimlerinizde yavaşlama sorunu yaşarsınız. Ben tavsiye etmiyorum.

İstediğiniz yönde bir uygulama aşağıdaki linkteki #7 nolu mesajda örnekle yapılmış. İnceleyiniz.

aktif hücrenin bulunduğu satır renklensin

Belki aşağıdaki yöntem daha hızlı sonuç verebilir...

Sayfanızın orjinal bir kopyasını boş bir sayfaya aktarırsınız.

Her hücre seçiminizde ilk önce orjinal yapı kopyalanır. Sonra seçtiğiniz alanda istediğiniz biçimlendirme yapılır. Böylece daha hızlı işlem yapılabilir. Tabiki emin değilim. Denemek lazım...
Genişletmek için tıkla ...



Korhan bey belirttiğiniz adresteki kod hücreye tıklayınca bütün bir satırı renklendiriyor. Peki sadece tıkladığımız hücrenin renklenmesi için kodda hangi kısımları değiştireceğiz?

Örnek kodu aşğıya ekliyorum:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
Static eskirenkler(256)
Static a 'eski sutun
Static b 'eski satır
If a <> "" Then
If b = bb Then Exit Sub
For i = 1 To 256
If Cells(b, i).Interior.ColorIndex = 22 Then
Cells(b, i).Interior.ColorIndex = eskirenkler(i - 1)
End If
eskirenkler(i - 1) = Cells(ActiveCell.Row, i).Interior.ColorIndex
Next i
End If
ActiveCell.EntireRow.Interior.ColorIndex = 22
a = ActiveCell.Column
b = ActiveCell.Row
Application.ScreenUpdating = True
End Sub
 
Merhaba,

Kırmızı renkli satırı mavi renkli satırla değiştirip deneyin.

Kod: 
[COLOR="Red"]ActiveCell.EntireRow.Interior.ColorIndex = 22[/COLOR]

Kod: 
[COLOR="Blue"]ActiveCell.Interior.ColorIndex = 22[/COLOR]
 
Korhan bey çok teşekkür ederim. Son bir sorum olcaktı: tıklanan satıra göre mesela A sütunu ile D sütunu arasında renklenmesini isteseydik. Nasıl bir değişiklik yapardık?
 
Aşağıdaki gibi olurdu.

Kod: 
Range("A" & ActiveCell.Row & ":D" & ActiveCell.Row).Interior.ColorIndex = 22

Ya da;

Kod: 
Cells(ActiveCell.Row, "A").Resize(1,4).Interior.ColorIndex = 22
 
Korhan Ayhan' Alıntı:
Aşağıdaki gibi olurdu.

Kod: 
Range("A" & ActiveCell.Row & ":D" & ActiveCell.Row).Interior.ColorIndex = 22

Ya da;

Kod: 
Cells(ActiveCell.Row, "A").Resize(1,4).Interior.ColorIndex = 22
Genişletmek için tıkla ...

Korhan bey son soru demiştim ama aklıma takılan bir nokta var cevaplayabilirmisiniz?

Bu kodları uyguladığımızda herhangi bir hücreye tıklanınca A ile D sütunu arasındaki satır renkleniyor. Peki herhangi bir hücreye değilde sadece A ile D sütunu arasında bir hücreye tıklayınca renklenmesini nasıl sağlarız?

Kodun son halini gönderiyorum:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
Static eskirenkler(256)
Static a 'eski sutun
Static b 'eski satır
If a <> "" Then
If b = bb Then Exit Sub
For i = 1 To 256
If Cells(b, i).Interior.ColorIndex = 22 Then
Cells(b, i).Interior.ColorIndex = eskirenkler(i - 1)
End If
eskirenkler(i - 1) = Cells(ActiveCell.Row, i).Interior.ColorIndex
Next i
End If
Range("A" & ActiveCell.Row & ":D" & ActiveCell.Row).Interior.ColorIndex = 22
a = ActiveCell.Column
b = ActiveCell.Row
Application.ScreenUpdating = True
End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst