Oluşan rapora göre pano çizgilerinin çizilmesi

[yolcu50]

Arkadaşlar ekli çalışma sayfamda veri sayfasındaki verileri rapor sayfasına aktarılıyor. Benim istediğim aktarılan satırın çerçevesinin ve içinin çizgilerininde kod yardımı ile çizilmesi bu mümkünmü. mesela 4 satırlık rapor oluştu ise sadece 4 satır ı kapsayan çizgilerin oluşmasını istiyorum.

 

[isfa5878]

merhaba..

Sub inceCiz()
Range("B" & ActiveCell.Row & ":F" & ActiveCell.Row).Borders(xlEdgeTop).Weight = xlSolid
End Sub

Sub KalınCiz()
Range("B" & ActiveCell.Row & ":F" & ActiveCell.Row).Borders(xlEdgeTop).Weight = xlMedium
End Sub

kendinize göre uyarlayanız....

 

[yolcu50]

kardeş teşekkür ederim ancak senin yazıdğın rapordan bağımsız olarak çizgi çiziyor. BENİM İSTEDİĞİM RAPOR KAÇ SATIRI VE SÜTUNU KAPSARSA ONA GÖRE SATIR VE SÜTUN ÇİZGİLERİNİN OLUŞMASI

 

[Seyit Tiken]

Bu kodu deneyiniz. İhtiyacınızı karşılıyor mu?

Sub Makro1()
Sheets("Rapor").[a2].Select
Range(Selection, Selection.End(xlDown)).Interior.ColorIndex = 36
End Sub

 

[yolcu50]

kardeş teşekkür ederim ancak bu hücreyi renklendiriyor. çizmiyor

 

[isfa5878]

istediğiniz sayfa kopyalamamı ?
ekte ki dosyayı inceleyiniz.

 

[yolcu50]

isfa5878 ilgin için teşekkür ederim. ancak istediğimi anlatamadım galiba , rapor sayfasında iken aktar butonuna bastığım zaman a1:h7 bölümüne bilgi geliyor. bu aralığın çerçeve içerisine alınmasını istiyorum. bilgilere göre rapor değişiklik gösterdiği zamanda bu çerçeve değişiklik gösterecek. çerçeve içerisinde satır ve sütunlarda çizilmiş olacak

 

[isfa5878]

uyarlayabilirseniz şöyle bir kod daha var elimde

sub ()
Range("A3:H13").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Range("A1").Select
End sub

 

[isfa5878]

Range("A3:H13").Select
satırı aşağıdakiyle değiştiriniz

Range("A1").Select
Range(Range("A1"), ActiveCell.SpecialCells(xlLastCell)).Select

verileriniz a1 boş bırakmayacak şekilde düzenlerseniz çaılşacağını tahmin ediyorum.

 

[yolcu50]

Aşağıdaki kod ile çizim yapılıyor ancak çizim Range("A1:H13").Select satırı sebebiyle bu aralıkta sabit oluyor. rapora göre aralık artıp azalıyor bu sebeple bunu (A:H) arasındaki sütunlarda dolu olan sütunları kapsamasını nasıl sağlarız
ustalarım lütfen yardım



Sub tablo()
Range("A1:H13").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Range("A1").Select
End Sub

 

[isfa5878]

son mesajımı okudunuz mu?

Range("A3:H13").Select

satırı aşağıdakiyle değiştiriniz

Range("A1").Select
Range(Range("A1"), ActiveCell.SpecialCells(xlLastCell)).Select

verileriniz a1 boş bırakmayacak şekilde düzenlerseniz çaılşacağını tahmin ediyorum.

 

[yolcu50]

son mesajımı okudunuz mu?

Range("A3:H13").Select

satırı aşağıdakiyle değiştiriniz

Range("A1").Select
Range(Range("A1"), ActiveCell.SpecialCells(xlLastCell)).Select

verileriniz a1 boş bırakmayacak şekilde düzenlerseniz çaılşacağını tahmin ediyorum.

böyle yaptığım zaman tüm sayfayı çiziyor

 

[yolcu50]

adminlerden yardım bekliyorum

 

[yolcu50]

Uzmanlarim LÜtfen Yardim

 

[isfa5878]

şöyle deneyin.

Private Sub CommandButton1_Click()
Range(Range("A1"), ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Range("A1").Select
End Sub

 

[yolcu50]

denedim kardeş tüm sayfayı çiziyor benim istediğim sadece dolu hücreler

 

[isfa5878]

son kodlar bende hata vermiyordu
a1:f23 e veri girip temizledikten sonra boşalan hücreleride aktif kabul etti.

taze sayfada hata vermiyormuş.

 

[yolcu50]

son kodlar bende hata vermiyordu
a1:f23 e veri girip temizledikten sonra boşalan hücreleride aktif kabul etti.

taze sayfada hata vermiyormuş.

PEKİ NASIL YAPMAMIZ GEREKİYOR...

 

[yolcu50]

Bu kodu deneyiniz. İhtiyacınızı karşılıyor mu?

Sub Makro1()
Sheets("Rapor").[a2].Select
Range(Selection, Selection.End(xlDown)).Interior.ColorIndex = 36
End Sub

BU KOD TAM İSTEDİĞİM GİBİ AMA RENKLENDİRİYOR. KOD U NASIL DEĞİŞTİRİRSEK RENKLENDİRME YERİNE ÇİZER

 

[yolcu50]

ustalarım hani bilgi paylaşmak içindi. teşekkür ederim bayağı yardımcı oldunuz ???????