sayfada birleştirilmiş hücrelerin satırlarını otomatik ayarlama

[hepturk]

Merhabalar

Önceki konuları inceledim,sadece 1. satır 'da ve 2 sütunun birleştirildiği kodu gördüm,bana lazım olan ise 1 sayfanın tümünde hangi sütunlar birleştirildi ise tümünün otomatik satır yüksekliğinin ayarlanması.Yani ayrı ayrı satır ya da sütun girmemek.

yardımcı olan olursa sevinirim,teşekkürler

 

[Korhan Ayhan]

Merhaba,

Yardımcı olabilmemiz için sorunuzu örnek dosya ile desteklermisiniz.

 

[hepturk]

örnek dosya ektedir

 

[Necdet]

Merhaba,

Farklı yöntemler olabilir.

Aşağıdaki kodları deneyiniz.

Sub Makro1()
    
    Dim Alan As Range
    Dim Hucre As Range
    
    Set Alan = Range("A1", Selection.SpecialCells(xlCellTypeLastCell).Address)
    
    For Each Hucre In Alan
        If Hucre.MergeCells Then Hucre.RowHeight = 40
    Next Hucre
    
End Sub

 

[hepturk]

sağolun hocam ,lakin hücreler gereğinden fazla boşluklu.
ayrıca 2 sütunu birleştirdiklerimde çalışmadı sadece 40 kadar açtı satırı o kadar ,yani içerik 60-70 de olsa 40 da kaldı ve açılmadı,makroyu da her defasında çalıştırdığım halde.

gönderdiğiniz makronun mantığı şu şekilde sanırım;"hücredeki girdinin yüksekliği tek satırdan fazla ise direk satır yüksekliğini 40'a ayarlıyor,40'dan da fazla ise bir alttaki satırı da 40 kadar açıyor "...bunu içerik ne kadar yükseklikteyse onu 2 ye ya da yerine göre 3 e bölüp o kadar satır yüksekliğini ayarlayacak şekilde olsa daha güzel olur gibi?

saygılarımla

 

[Korhan Ayhan]

Merhaba,

Ekteki örnek dosyayı inceleyiniz.

Birleştirilmiş hücrelere girip çıktığınızda otomatik olarak düzelecektir.

Kodu hücre değişim olayına bağladım. Dilenirse modül kodu olarakta düzenlenebilir.

 

[Necdet]

Merhaba,

İnternette aşağıdaki kodları buldum ve üzerinde biraz değişiklik yaptım.
Bu kodları dener misiniz?

'http://help.lockergnome.com/office/Merged-cells-Autofit-row-height--ftopict917862.html
Sub BirlestirilmisHucreYuksekligi()
    Dim Alan        As Range
    Dim Hucre       As Range
    Dim NewRwHt     As Single
    Dim cWdth       As Single
    Dim MrgeWdth    As Single
    Dim c           As Range
    Dim cc          As Range
    Dim ma          As Range
    
    Set Alan = Range("A1", Selection.SpecialCells(xlCellTypeLastCell).Address)
    
    For Each Hucre In Alan
    
        With Hucre
            cWdth = 0: MrgeWdth = 0
            If .MergeCells And .WrapText Then
                Set c = Hucre.Cells(1, 1)
                cWdth = c.ColumnWidth
                Set ma = c.MergeArea
                                
                For Each cc In ma.Cells
                    MrgeWdth = MrgeWdth + cc.ColumnWidth
                Next
                
                Application.ScreenUpdating = False
                ma.MergeCells = False
                c.ColumnWidth = MrgeWdth
                c.EntireRow.AutoFit
                NewRwHt = c.RowHeight
                c.ColumnWidth = cWdth
                ma.MergeCells = True
                ma.RowHeight = NewRwHt
                Application.ScreenUpdating = True
            End If
        End With
        
    Next Hucre
    
End Sub

 

[hepturk]

Allah razı olsun hocalarım ikinizden de ,korhan hocanın gönderdiği excel tam istediğim gibi olmuş..
2.sayfaya bağlı kalmak istemezsek istersek diye necdet hocanınkini denedim önceki problemle karşılaştım 3 satırlık içerikte neredeyse 10 satır yüksekliğinde açılıyor ve bir sürü boşluk kalıyor

teşekkürler yine de ,kolay gelsin

 

[Korhan Ayhan]

Merhaba,

Üstteki mesajımdaki dosyayı güncelledim. Artık Sayfa2 ye gerek kalmadı. Silebilirsiniz.

 

[hepturk]

cillop gibim olmuş

eyvallah hocam eline sağlık