• DİKKAT !

    Forum içeriğine ve tüm hizmetlerimize erişim sağlamak için foruma kayıt olmalı ya da giriş yapmalısınız. Foruma üye olmak Dosya Yükleme tamamen ücretsizdir.

Çözüldü Dinamik Tabloda Başlık Ve Kenarlık Sorunu

Bu konu çözüldü olarak işaretlenmiştir. Çözülmediğini düşünüyorsanız konuyu rapor edebilirsiniz.
Durum
Konu Çözümlendiği İçin Kapatılmıştır.

Mtudes

Yeni Üye
Katılım
30 Ağu 2021
Mesajlar
270
Çözümler
1
Aldığı beğeni
97
Excel V
Office 2016 TR
Konu Sahibi
Merhaba
Borcsorgu userformunda comboboxlarla seçtiğim verileri listbox1 de sorgula butonuyla listeliyorum.Tablo al butonuyla da bu listelenen verilerden ödenmeyenleri Tablo sayfasında listeliyorum.Tablo sayfasında 4. satırda tablo başlıkları mevcut ve burada ücret ve protokol no kısmı birden fazla olabiliyor.Ücret ve protokol no başlıklarını kendim oluşturduğumda veriler fazla olduğunda başlıksız kalmış oluyor,az olduğunda ise başlıklar boşta kalıp tablo çirkin bir görüntüye sahip oluyor.Aynı sorun kenarlıklar içinde mevcut.Oluşacak tabloya göre başlık ve hücre kenarlıklarını oluşturmasını istiyorum.
Yardımcı olursanız sevinirim.
 
Sayın Mtudes dosyanız ekte.
excelcozum makrosunda en altta End If satırının altına
Call bicimlendir diye ekledim. excelcozum kodları iki şartın gerçekleşmesini
şart koşuyor. Dolayısıyla sütun başlıkları ücret, protokol no diye sıradüzende
devam etmek durumunda. Ben de bu sıradüzen zorunluluğundan hareketle kod oluşturdum.
Bilginize. Kodlar aşağıda.

Sub bicimlendir()

With Sheets("TABLO")
Application.ScreenUpdating = False

.Cells.Borders.LineStyle = 0 'kenarlıkları temizle
lastCol = .Range("A5").End(xlToRight).Column
son_sat = .Cells(Rows.count, "A").End(3).Row

.Range("A4", .Cells(4, lastCol)).ClearContents
.Range("A4") = "SIRA": .Range("B4") = "FİRMA ADI": .Range("C4") = "PROJE ADI"

For sut = 4 To lastCol Step 2
Cells(4, sut) = "ÜCRET"
If IsEmpty(Cells(4, sut + 1)) Then Cells(4, sut + 1) = "PROTOKOL NO"
Next

.Range("A4", .Cells(son_sat, lastCol)).Borders.LineStyle = 1 'kenarlık kodu
.Range("A4", .Cells(4, lastCol)).Interior.ColorIndex = 6 'renk kodu

Application.ScreenUpdating = True

End With

lastCol = Empty: sut = Empty: son_sat = Empty

End Sub
 
Bu da alternatifiniz. İyi geceler.
 
Çözüm
Konu Sahibi
Merhaba
Çok teşekkür ederim Sayın ubak ve Sayın excelcan elinize sağlık. Normal sayfada kenarlıklar da sorun yok ama yazdırma ekranında kimi kenarlık çıkmıyor.Bunun sebebi ne olabilir acaba ?
 
Durum
Konu Çözümlendiği İçin Kapatılmıştır.
Geri
Üst