• DİKKAT

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

Hücre doluysa kenarlık olsun

Hakan ERDOST

Destek Ekibi
Destek Ekibi
Katılım
12 Eylül 2004
Mesajlar
885
Excel Vers. ve Dili
Excel 2019 Türkçe (Ev)
Excel 2013 Türkçe (Okul)
Herkese merhaba.Bir çalışma sayfasında hücrelere veri girdikçe veri girilen hücrelere kenarlık yapacak bir kod mümkün mü?
 
Merhaba,

Bu işlemi koşullu biçimlendirme kullarak da yapabilirsiniz.

Örnek A1:A10 aralığını fare ile seçin,

Koşullu Biçimlendirmeye girerek formül bölümüne;

=A1<>""

yazın ve biçimden kenarlıklara girerek istediğiniz kenarlığı seçtikten sonra işlemi bitirin. Artık A1:A10 aralığında veri girdiğiniz hücrede kenarlık oluşacaktır.

Kod ile isterseniz.

Çalışma sayfasının kod bölümüne kopyalayınız..

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A1:A10]) Is Nothing Then Exit Sub
Target.Borders.LineStyle = 1
End Sub

.
 
Son düzenleme:
Kod ile ilgili olarak:
Teşekkürler.Ancak birincisi Birleştirilmiş hücrelerde sorun oluyor, diğer bir sorunda hücreye çift tıklayıncada kenarlık oluşuyor, ayrıca veri silinince kenarlık kalıyor..
 
Son düzenleme:
dolu hücrelere otomatik kenarlık

bunu dener misin.
Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, [b1:b10]) > "" Then
Target.Borders.LineStyle = 1
End If
If Intersect(Target, [b1:b10]) = "" Then
Target.Borders.LineStyle = 0
End If
End Sub
 
Selamlar,

Birleştirilmiş hücrelerdeki sorunu aşağıdaki kod ile aşabilirsiniz.

Kod:
Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.MergeCells = True Then
        Target.Select
        If ActiveCell <> "" Then
            Selection.Borders.LineStyle = 1
            Target.Offset(1, 0).Select
        Else
            Selection.Borders.LineStyle = 0
        End If
    Else
        Target.Select
        If ActiveCell <> "" Then
            Selection.Borders.LineStyle = 1
            Target.Offset(1, 0).Select
        Else
            Selection.Borders.LineStyle = 0
        End If
    End If
End Sub
 
Geri
Üst