kenarlık ekleme

SeÖzGü · 3 Aralık 2019

Merhaba,

Sürekli satır sayısı değişen bir raporum mevcut. Bu sütunlarda dolu olan hücrelere kenarlık eklemek istiyorum. Elimde sadece belirtilen satır kadar kenarlık eklemek için kod var. Kıymetli bilgi ve yardımlarınızı rica ederim.

klop01 · 3 Aralık 2019

Koşullu biçimlendirme kısmına yazılacak formülle yapılabiliyor. Dolu hücreye kenarlık ekleme şeklinde

Seyit Tiken · 3 Aralık 2019

Örnek dosyayı inceleyiniz.

SeÖzGü · 4 Aralık 2019

Seyit Tiken' Alıntı:
Örnek dosyayı inceleyiniz.

malesef açılmıyor seyit bey

çıtır · 4 Aralık 2019

Sorunuzu örnek excel dosyası ekleyerek sorarsanız,daha kısa sürede doğru cevaplar alabilirsiniz. Örnek excel dosyası ekleme hakkında bilgi edinmek isterseniz: https://www.excel.web.tr/threads/soru-ile-ilgili-oernek-excel-dosyasi-ekleme.174755/...

SeÖzGü · 6 Aralık 2019

çıtır' Alıntı:
Sorunuzu örnek excel dosyası ekleyerek sorarsanız,daha kısa sürede doğru cevaplar alabilirsiniz. Örnek excel dosyası ekleme hakkında bilgi edinmek isterseniz: https://www.excel.web.tr/threads/soru-ile-ilgili-oernek-excel-dosyasi-ekleme.174755/...

ekleyemedım excel doyasını kodu paylaşıyorum

Kod:

Sub RAPOR()
'
' RAPOR Macro
'
' Keyboard Shortcut: Ctrl+Shift+C
'
    Cells.Select
    With Selection.Font
        .Name = "Arial"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    With Selection.Font
        .Name = "Arial"
        .Size = 8
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Cells.Select
    Range("J1").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$P$1992").AutoFilter Field:=10, Criteria1:=Array( _
        "AAAAAA", "CCCCC", "DDDDDDD", "EEEEEEEEE"), Operator:=xlFilterValues
    Range("A2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.EntireRow.Delete
    Selection.AutoFilter
    Range("A1:P88").Select
    Range("H16").Activate
    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
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    With Selection.Font
        .Color = -16776961
        .TintAndShade = 0
    End With
    Selection.Font.Bold = True
    Range("I2").Select
    Range(Selection, Selection.End(xlDown)).Select
    With Selection.Font
        .Color = -16776961
        .TintAndShade = 0
    End With
    Selection.Font.Bold = True
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("E22").Select
    ActiveWindow.SmallScroll Down:=39
    Sheets("İşlem Dagılımı").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$N$358").AutoFilter Field:=7, Criteria1:=Array( _
        "AAAAAA", "BBBBBB", "CCCCCCCC", "DDDDDDDD"), Operator:=xlFilterValues
    Range("A2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.EntireRow.Delete
    Selection.AutoFilter
    Cells.Select
    With Selection.Font
        .Name = "Arial"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    With Selection.Font
        .Name = "Arial"
        .Size = 8
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("A1:N7").Select
    Range("A4").Activate
    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
    Range("F5").Select
    Sheets("Çıkması Gereken Yazılar").Select
    Cells.Select
    With Selection.Font
        .Name = "Arial"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    With Selection.Font
        .Name = "Arial"
        .Size = 8
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Range("J1").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$P$475").AutoFilter Field:=10, Criteria1:=Array( _
        "AAAAAAA", "BBBBBBB", "CCCCCCCCC", "DDDDDDDD"), Operator:=xlFilterValues
    Range("A2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.EntireRow.Delete
    Selection.AutoFilter
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("A1:P36").Select
    Range("F19").Activate
    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
    Range("D20").Select
    Sheets("İşlem Havuzu").Select
    ActiveWindow.SmallScroll Down:=-57
   
End Sub

SeÖzGü · 9 Aralık 2019

konu güncel olup desteklerinizi rica ediyorum

metin_0606 · 9 Aralık 2019

Seyit Tiken' Alıntı:
Örnek dosyayı inceleyiniz.

bunun tekniği nedir seyit bey inceledim ama çözemedim

Necdet · 10 Aralık 2019

metin_0606' Alıntı:
bunun tekniği nedir seyit bey inceledim ama çözemedim

Koşullu Biçimlendirme.

Koşulla biçimlendirilmiş hücreleri görmek için :

F5
Özel
Koşullu Biçimler
Tamam

Seyit Tiken · 10 Aralık 2019

Koşullu Biçimlendirme ile dolu olan hücreye kenarlık ekliyor.

euphrates55 · 10 Aralık 2019

deneyiniz.
Cells(2, 13) kısmını kendinize uyarlayın. 2. satır 13. sütundan başlıyor diye yazdım. siz başlangıcı kendinize göre yazın

Kod:

Sub kenarlik()
Dim ssatir As Long, sdoluhcr As Long
ssatir = Cells.Find(What:="*", After:=Cells(1, 1), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
sdoluhcr = Cells.Find("*", , , , xlByColumns, xlPrevious).Column
Range(Cells(2, 13), Cells(ssatir, sdoluhcr)).Borders.LineStyle = xlContinuous
End Sub

SeÖzGü · 12 Aralık 2019

euphrates55' Alıntı:
deneyiniz.
Cells(2, 13) kısmını kendinize uyarlayın. 2. satır 13. sütundan başlıyor diye yazdım. siz başlangıcı kendinize göre yazın

Kod:

Sub kenarlik() Dim ssatir As Long, sdoluhcr As Long ssatir = Cells.Find(What:="*", After:=Cells(1, 1), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row sdoluhcr = Cells.Find("*", , , , xlByColumns, xlPrevious).Column Range(Cells(2, 13), Cells(ssatir, sdoluhcr)).Borders.LineStyle = xlContinuous End Sub

Merhaba Üstadım süper çalışmakta kendime göre uyarladım fakat 3 sheet var bunlara da uygulanması mümkün mü

euphrates55 · 12 Aralık 2019

SeÖzGü' Alıntı:
Merhaba Üstadım süper çalışmakta kendime göre uyarladım fakat 3 sheet var bunlara da uygulanması mümkün mü

üstad tuhaf oldu. makronun m sini bilmem ama yardım etmek için senin yerine araştırdım. aşağıdakini deneyin. bana da haber verirsiniz.

Kod:

Sub hepsi()
Dim i As Integer
Dim ssatir As Long, sdoluhcr As Long
For i = 1 To Sheets.Count
    Sheets(i).Select
ssatir = Cells.Find(What:="*", After:=Cells(1, 1), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
sdoluhcr = Cells.Find("*", , , , xlByColumns, xlPrevious).Column
Range(Cells(1, 1), Cells(ssatir, sdoluhcr)).Borders.LineStyle = xlContinuous
Next
End Sub

SeÖzGü · 13 Aralık 2019

euphrates55' Alıntı:
üstad tuhaf oldu. makronun m sini bilmem ama yardım etmek için senin yerine araştırdım. aşağıdakini deneyin. bana da haber verirsiniz.

Kod:

Sub hepsi() Dim i As Integer Dim ssatir As Long, sdoluhcr As Long For i = 1 To Sheets.Count Sheets(i).Select ssatir = Cells.Find(What:="*", After:=Cells(1, 1), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row sdoluhcr = Cells.Find("*", , , , xlByColumns, xlPrevious).Column Range(Cells(1, 1), Cells(ssatir, sdoluhcr)).Borders.LineStyle = xlContinuous Next End Sub

Valla üstad yerinde olmuş

harika çalışmakta ellerinize emeğinize sağlık

Necdet · 13 Aralık 2019

Merhaba,

Benimde katkım olsun. Düzenli tablolarda kullanmak üzere yazdığım kodları paylaşmak istiyorum.
Sayfa aktif olduğunda otomatik olarak kenar çizgisi ekler.
Sayfa kontrolü vardır örneğin aşağıdaki kodlar Sayfa adları "Rapor" ile başlıyorsa uygulanır.
Tablo 1. satır ve 1. sütunda başlıyorsa çalışır. Farklı satır ve sütunda başlıyorsa kodu kendinize göre uyarlamalısınız.

Tablonun dış kenar kalınlığını belirliyebilirsiniz fakat iç çizgiler normal kalınlıktadır.
Düzenli tablo ve alt satırda toplam varsa hem 1. satırı hem son satırı Kalın çizmek olası, parametreyi ona göre belirlemek gerek.
Ayrıca hem 1 hem de sonuncu satırda arkaplan rengini Gri yapmak ta olası.
Kodlar sayfa aktif olduğunda çalışır.

Aşağıdaki kodlar BuÇalışmaKitabı'nın kod bölümünde olmalı.

Kod:

Private Sub Workbook_SheetActivate(ByVal Sh As Object)

    On Error GoTo Son
    If ActiveSheet.Name Like "Rapor*" Then
        Range("B1").End(xlDown).Offset(1, -1).Select
        Cizgi Range(ActiveSheet.Name & "!" & Range("A1").CurrentRegion.Address), 4, 3, 3
    End If
Son:

End Sub

Aşağıdaki kodlar ise Bir Modülde olmalı.

Kod:

Sub Cizgi(Alan As Range, ÇerçeveKalınlığı As Integer, _
          Optional Tip_AltUst_Cizgi As Integer = 0, _
          Optional Tip_AltUst_ArkaPlan As Integer = 0)

    'Tip :
    '       0 : Alt Ve Ust Cizgi Arka Plan Rengi Yok
    '       1 : Ust Cizgi Arka Plan Rengi Var
    '       2 : Alt ve Arka Plan Rengi Var
    '       3 : Alt Ve Ust Cizgi Arka Plan Rengi VAR
  
  
    Dim Bit As Long
  
    Bit = Alan.Rows.Count
  
    Application.ScreenUpdating = False
  
    With Cells
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        .Borders(xlEdgeLeft).LineStyle = xlNone
        .Borders(xlEdgeTop).LineStyle = xlNone
        .Borders(xlEdgeBottom).LineStyle = xlNone
        .Borders(xlEdgeRight).LineStyle = xlNone
        .Borders(xlInsideVertical).LineStyle = xlNone
        .Borders(xlInsideHorizontal).LineStyle = xlNone
        With .Interior
            .Pattern = xlNone
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
    End With
  
    With Alan.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ThemeColor = 1
        .TintAndShade = -0.25
        .Weight = ÇerçeveKalınlığı 'xlMedium
    End With
  
    With Alan.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ThemeColor = 1
        .TintAndShade = -0.25
        .Weight = ÇerçeveKalınlığı 'xlMedium
    End With
  
    With Alan.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ThemeColor = 1
        .TintAndShade = -0.25
        .Weight = ÇerçeveKalınlığı 'xlMedium
    End With
  
    With Alan.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ThemeColor = 1
        .TintAndShade = -0.25
        .Weight = ÇerçeveKalınlığı 'xlMedium
    End With
  
'   Çervenin İçi Çizilir ------
  
    With Alan.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ThemeColor = 1
        .TintAndShade = -0.25
        .Weight = xlThin
    End With
  
    With Alan.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ThemeColor = 1
        .TintAndShade = -0.25
        .Weight = xlThin
    End With
'   Çerçevenin İçi Bitti...................


'Birinci Satırın Altı Kalın Çizilir
  
'    Range(Alan.Rows(1).Address).Interior.ColorIndex = 34
    If Tip_AltUst_ArkaPlan = 1 Or Tip_AltUst_ArkaPlan = 3 Then
        With Range(Alan.Rows(1).Address).Interior
            .ThemeColor = xlThemeColorDark1
            .TintAndShade = -4.99893185216834E-02
        End With
    End If
    If Tip_AltUst_Cizgi = 1 Or Tip_AltUst_Cizgi = 3 Then
        With Range(Alan.Rows(1).Address).Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ThemeColor = 1
            .TintAndShade = -0.25
            .Weight = ÇerçeveKalınlığı 'xlMedium
        End With
    End If
  
'Son satırın Altı Kalın Çizim Sonu
  
    'Sonuncu Satırın Üstü Kalın Çizilir
'    Range(Alan.Rows(Bit).Address).Interior.ColorIndex = 24
  
    If Tip_AltUst_ArkaPlan = 2 Or Tip_AltUst_ArkaPlan = 3 Then
        With Range(Alan.Rows(Bit).Address).Interior
            .ThemeColor = xlThemeColorDark1
            .TintAndShade = -4.99893185216834E-02
        End With
    End If
  
    If Tip_AltUst_Cizgi = 2 Or Tip_AltUst_Cizgi = 3 Then
        With Range(Alan.Rows(Bit).Address).Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .ThemeColor = 1
            .TintAndShade = -0.25
            .Weight = ÇerçeveKalınlığı 'xlMedium
        End With
    End If
  
    Application.ScreenUpdating = True
  
End Sub

Kodları kullanan arkadaşlar ek özellik eklerse ben de yararlanmak isterim.

kenarlık ekleme

SeÖzGü

klop01

Seyit Tiken

Uzman

Ekli dosyalar

SeÖzGü

çıtır

SeÖzGü

SeÖzGü

metin_0606

Necdet

Moderatör

Seyit Tiken

Uzman

euphrates55

SeÖzGü

euphrates55

SeÖzGü

Necdet

Moderatör

Ekli dosyalar