• DİKKAT

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

Kenarlık Makrosu

I

iplikci_80

Katılım
29 Kasım 2007
Mesajlar
1,110
Excel Vers. ve Dili
excel 2007
Arkadaşlar yapmak istediğim şey "LİSTE" sayfasındaki kodu revize ederek listeleme işlemi bittikten sonra örnekte de görüldüğü gibi listeleme 2 satır ise 3 satırın sonu, listeleme 1 satır is 2 satırın sonunu kalın çizgiyle kapatmak istiyorum.
 

Ekli dosyalar

Kod: 
Sub Kenarlik()
'
' Makro8 Makro
'

'
    Dim SonSatir As Integer
    SonSatir = Range("I65536").End(xlUp).Row
    Range("B2:I" & SonSatir + 1).Select
    'eski çizgileri silmek için
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    
    'ince çizgileri ayarlamak için
    Range("B2:I" & SonSatir + 1).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    
    'il satırı kalın yapmak için
    Range("B2:I2").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    
    'tümünü kalın yapma
    Range("B2:I" & SonSatir + 1).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Range("c3").Select
End Sub
 
Sayın askm ilginize çok teşekkür ederim. Cevabınızda ki kodları denedim fakat kenarlı oluşturmuyor. Hata bende de olabilir ama kontrol edebilir misiniz lütfen.
 
Kodları şu şekilde kısalttım.
Kod: 
Sub Kenarlik_Ekle()
Dim SonSatir As Integer
SonSatir = Range("I65536").End(xlUp).Row

Range("B2:I" & SonSatir + 1).Borders.LineStyle = 1 'ince çizgi eklemek için
  

With Range("B2:I" & SonSatir + 1)
        .Borders.LineStyle = xlNone
        .Borders.LineStyle = xlContinuous
        .Borders(xlEdgeLeft).Weight = xlMedium
        .Borders(xlEdgeTop).Weight = xlMedium
        .Borders(xlEdgeBottom).Weight = xlMedium
        .Borders(xlEdgeRight).Weight = xlMedium
End With

With Range("B2:I2")
        .Borders.LineStyle = xlNone
        .Borders.LineStyle = xlContinuous
        .Borders(xlEdgeLeft).Weight = xlMedium
        .Borders(xlEdgeTop).Weight = xlMedium
        .Borders(xlEdgeBottom).Weight = xlMedium
        .Borders(xlEdgeRight).Weight = xlMedium
End With


End Sub
 
BorderAround özelliğini inceleyebilirsiniz.
Yanıtlarda da biraz daha kısaltırsınız artık. ;)​
 
Son düzenleme:
Süpersiniz. O kadar kod (makro kaydet ile yapılan) bu kadar kısaldı.

Kod: 
Sub Kenarlik_Ekle()
Dim SonSatir As Integer
SonSatir = Range("I65536").End(xlUp).Row
Range("B2:I" & SonSatir + 1).Borders.LineStyle = 1 'ince çizgi eklemek için
Range("B2:I" & SonSatir + 1).BorderAround _
        ColorIndex:=1, Weight:=xlThick 'Genel kalın çizgi
Range("B2:I2").BorderAround _
        ColorIndex:=1, Weight:=xlThick 'ilk satır kalın çizgi
End Sub
 
Sayı askm EK 'te ki çalışmada yapıyorum ama olmuyor. Rica etsem kontrol edebilir misiniz lütfen.
 

Ekli dosyalar

Makro kaydet bize yapılan her işlemin kodlarını verir ama işi biraz uzatır.

Örnek olarak; su içmek istesek.. makro kaydet bize der ki; bardağı göster, elini bardağa götür, bardağı tut, bardağı kaldır, bardağı kendine çek, bardağı ağzına götür, suyu iç :) ne gerek var bütün bunlara.. Excel'in eski versiyonlarında (2003 ve öncesi) kod yazanlar, iş görecek kodları bilirler. Örneğin; makro kaydet ile herhangi bir sıralama işlemini yapsanız, yine size çok fazla satır kod verir, halbuki; tek satır kod o işlemi yapmak için yeterlidir. Bunu nereden biliyoruz; tecrübemizden..

Siz de makroya hâkim olduktan sonra unuttuğunuz bazı kısımları hatırlatmak için makro kaydeti kullanacaksınız onun haricinde pek işiniz olmayacak. ;)​
 
Son satırı I sütununa göre bakıyor. SonSatir = Range("I65536").End(xlUp).Row satırındaki I harfini istediğiniz gibi değiştirirseniz olur.
 
Sayın Murat Bey ve sayın askm her şey için çok teşekkür ederim.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst