kenarlık-çerçeve yapımı

[muratkul]

Merhabalar,
Ekteki dosyada olduğu gibi her numara değiştiğinde aynı numaraları çerçeve içine almasını istiyorum.YArdımcı olabilirmisiniz.

 

[çıtır]

Sayfanın kodu olarak kopyalayınız.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [C9:C10000]) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
 ActiveWindow.DisplayGridlines = False
Dim i As Integer
son = Cells(65536, "C").End(3).Row
Range("A9:R" & son + 1).Select
Selection.Borders.LineStyle = 0
Range("A9:R" & son).Select
Selection.Borders.LineStyle = 1
Selection.Borders.ColorIndex = 17
  For i = 9 To son
If Range("C" & i) = "" Then
Range("A" & i).EntireRow.Delete
End If
If Range("C" & i) <> Range("C" & i + 1) Then
Range("a" & i & ": R" & i).Select
With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
     Range("R9" & ": R" & son).Select
    With Selection.Borders(xlEdgeRight)
    .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
        End With
        Range("A9" & ": A" & son).Select
    With Selection.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
        End With
 End If
 Next i
 Range("C" & son + 1).Select
Application.ScreenUpdating = True
End Sub

 

[muratkul]

Merhaba ilgili kodu (kod Grörüntüle) kısmına yapıştıracağız galiba. Peki nasıl çalıştıracağız bu makroyu

 

[çıtır]

Geliştirici menüsü var ise Visual Basic tıkla Dosyada ki sayfa isimleri görülür.Sayfa1(Sayfa1) gibi .Sayfa1(Sayfa1) çift tıkla ve yandaki beyaz alana kopyala sonra A9 tan itiberen yazılar yazarak deneyiniz.

 

[muratkul]

Merhabalar efendim. A9 sütununa ben yazı yazarak değil, bu rapor zaten hazır programdan alıyorum.yani ben yazı yazmayacam.mesela ctrl+k dediğimde yada makroya bir resim ekleyip makroyu o resme atayıp resme tıkladığımızda her a9daki temsil.ıd değiştiğinde otomatik kenar ve çerçeve oluştursun.
YApmış olduğunuz kod yazdıkça çerçeveye alıyor, ama benim istediğim bu değil.

 

[çıtır]

C9 göre düzenlendi deneyerek sonuçu bildiriniz.

 

[muratkul]

Kusura bakmayın.hazır raporu yapıştırdığımda kod çalıştı. Elinize sağlık. Peki burada bir değişiklik yapabilirmiyiz. Bu temsil ID A9 DA DEĞİLDE c9 da olursa nasıl birşey yapabiliriz.

 

[muratkul]

Çok teşekkür ederim.

 

[çıtır]

Çok teşekkür ederim.

Rica ederim:dönüş yaptığınız için teşekkür ederim.Kolay gelsin.

 

[muratkul]

Tekrar merhaba,
KOd normalde çalışıyor fakat filtre yaptığımda tarihi değiştirdiğimde otomatik güncellemiyor, bununla ilgili nasıl yardımcı olabşlir misiniz.

 

[muratkul]

Merhaba
elimde ekteki gibi dosya var. bu dosyada resime tıkladığım zaman çerçeveleri çizgileri otomatik çiziyor ama burada da sütün A DAKİ BİLGİLERE GÖRE BAŞLIYOR.
bu kodu sutun C YE AYARLAYABİLİRMİİSNİZ.

 

[çıtır]

C ye göre değiştirildi.Eski kodları silerek yeni konu kullanınız.

 

[muratkul]

Merhaba çıtır. Yapmış olduğunuz kod çalışıyor. teşekkürler ama filtre yaptığımızda tarih değiştirdiğimizde çizgi ve çerçeveyi yeni verilere göre güncellemiyor.

 

[çıtır]

Merhaba çıtır. Yapmış olduğunuz kod çalışıyor. teşekkürler ama filtre yaptığımızda tarih değiştirdiğimizde çizgi ve çerçeveyi yeni verilere göre güncellemiyor.

İsteğiniz.
Merhabalar,
Ekteki dosyada olduğu gibi her numara değiştiğinde aynı numaraları çerçeve içine almasını istiyorum.YArdımcı olabilirmisiniz.

Tarihlere veya diğer verilere göre çizgiler oluşmaz ,isteğiniz numaralara göre oluşması idi buna göre kodlar oluşturulmuştur.

 

[muratkul]

Merhaba Çıtır,
Benim istemiş olduğum kodu yaptınız teşekkürler.
Bu kodu Makro olarak nasıl ayarlarız acaba.

 

[muratkul]

Merhabalar,
kenarlık ve çizgi yerine her temsilcinin bulunduğu sütun ve satırları açık ve koyu dolgu rengi yapabilir.z. bunun için yardımcı olabilirmisiniz.

 

[çıtır]

cerceve yerine renk isteğiniz.Kolay gelsin.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [C9:C10000]) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
 ActiveWindow.DisplayGridlines = False
Dim i As Integer
son = Cells(65536, "C").End(3).Row
Range("A9").Interior.ColorIndex = 16
For i = 9 To son
Range("A9").Interior.ColorIndex = 16
ilk = Range("C" & i)
ilk1 = Range("C" & i + 1)
If ilk = ilk1 And ilk <> "" Then
Range("A" & i).Offset.Resize(1, 19).Interior.Color = Range("A" & i).Interior.Color
Range("A" & i + 1).Offset.Resize(1, 19).Interior.Color = Range("A" & i).Interior.Color
End If
If ilk <> ilk1 And ilk <> "" And Range("A" & i).Interior.ColorIndex = 16 Then
Range("A" & i + 1).Interior.ColorIndex = 24
Range("A" & i).Offset.Resize(1, 19).Interior.Color = Range("A" & i).Interior.Color
End If
If ilk <> ilk1 And ilk <> "" And Range("A" & i).Interior.ColorIndex = 24 Then
Range("A" & i + 1).Interior.ColorIndex = 16
Range("A" & i).Offset.Resize(1, 19).Interior.Color = Range("A" & i).Interior.Color
End If
Next i
Range("A" & son + 1).Interior.ColorIndex = xlNone
Application.ScreenUpdating = False
End Sub

 

[muratkul]

çok teşekkür ederim.çıtır

 

[muratkul]

bu makroya nasıl düğme yada resim ekleyeceğiz çıtır

 

[çıtır]

çok teşekkür ederim.çıtır

Rica ederim.Dönüş yaptığınız için teşekkür ederim.Kolay gelsin.