Birleştirilmiş hücrelerde otomatik satır yüksekliği

[magnesia]

Arkadaşlar selam.
A:I arası birleştirilmiş hücrelere veri girdiğimde satır yüksekliğinin otomatik olarak yükselmesini nasıl sağlayabilirim?
Şimdiden teşekkürler..

 

[Cengiz Demir]

Hücrede bir defaya mahsus Alt + Enter yaptığınızda, siz giriş yaptıkça, hücre genişliğini aşan veriler bir alt satıra inecek ve satır yüksekliği de bu duruma göre ayarlanacaktır.

İşlem yapacağınız hücre çok ise bir hücreyi ayarlayıp, biçim kopyalayıcı ile diğer hücrelere bu işlemi kopyalayabilirsiniz..

İkinci seçenek, hücreleri seçip , hücre biçinlendirden metni kaydırı seçebilirsiniz

 

[magnesia]

Cengiz arkadaşım..
Öncelikle ilginize ve emeğinize teşekkür ederim.
İki öneriniz de işe yaramadı maalesef.. (Sanırım birleştirilmiş hücre olduğu izin)
Çözümün sadece makro ile olduğunu düşünüyorum.
Tekrar teşekkürler.

 

[magnesia]

Sorumu güncellemek istiyorum.
Lütfen yardım.

 

[magnesia]

Yardım lütfen

 

[Korhan Ayhan]

Örnek dosyayı deneyiniz.

 

[magnesia]

Sayın Korhan Ayhan..
Tam istediğim gibi...İlginize, bilginize ve emeğinize sağlık..
Çok çok teşekkür ederim.

 

[hakankilic]

Örnek dosyayı deneyiniz.

Hocam belirli bir aralığın tamamında örnek.xlsm de her satırın değişiminde yükseklik ayarlamaktadır. Belirli bir aralıkta örneğin A1:A20 arasındaki tüm satırlarda aynı anda bu işlem yapılabilir mi?

 

[Korhan Ayhan]

Kodu boş bir modüle uygulayıp işlemi yapmak istediğiniz sayfada çalıştırın.

Option Explicit
 
Sub Satir_Yuksekligi()
    Dim S1 As Worksheet, Genislik As Integer, Yukseklik As Integer
    Dim Alan As Range, Veri As Variant, Satir As Integer, X As Integer
        
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    On Error Resume Next
    Sheets("Test").Delete
    On Error GoTo 0
    
    Sheets.Add
    Set S1 = ActiveSheet
    S1.Name = "Test"
    
    For Each Alan In Range("A1:A20")
        Genislik = Range("A1").Columns.Width
        Yukseklik = 0
        
        Satir = 2
        
        With S1
            .Cells.Delete
            .Cells.Font.Size = Alan.Font.Size
            .Range("A1") = Alan.Text
            .Range("A:A").WrapText = True
            .Range("A1").VerticalAlignment = xlJustify
            .Range("A1").ColumnWidth = Genislik / 5.3
            .Range("A1").EntireRow.AutoFit
            
            Veri = Split(.Range("A1"), Chr(10))
            
            For X = 0 To UBound(Veri)
                .Cells(Satir, 1) = Veri(X)
                Yukseklik = Yukseklik + .Cells(Satir, 1).RowHeight
                Satir = Satir + 1
            Next
            
            .Cells.Delete
        End With
        
        If Yukseklik = 0 Then Yukseklik = 15
        Alan.RowHeight = Yukseklik
    Next

    On Error Resume Next
    S1.Delete
    On Error GoTo 0
    
    Set S1 = Nothing

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

 

[bkr-ylmz]

Hocam selamlar,
Bu kodları örnekteki gibi bir formda çalıştırdığımda otomatik yüksekliği elde edemedim, yardımcı olabilir misiniz.

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit
 
Sub Satir_Yuksekligi()
    Dim S1 As Worksheet, Genislik As Integer, Yukseklik As Integer
    Dim Alan As Range, Veri As Variant, Satir As Integer, X As Integer
        
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    On Error Resume Next
    Sheets("Test").Delete
    On Error GoTo 0
    
    Sheets.Add
    Set S1 = ActiveSheet
    S1.Name = "Test"
    
    For Each Alan In Range("D2:D6,D20:D24")
        Genislik = Alan.Resize(, 4).Columns.Width
        Yukseklik = 0
        
        Satir = 2
        
        With S1
            .Cells.Delete
            .Cells.Font.Size = Alan.Font.Size
            .Range("A1") = Alan.Text
            .Range("A:A").WrapText = True
            .Range("A1").VerticalAlignment = xlJustify
            .Range("A1").ColumnWidth = Genislik / 5.3
            .Range("A1").EntireRow.AutoFit
            
            Veri = Split(.Range("A1"), Chr(10))
            
            For X = 0 To UBound(Veri)
                .Cells(Satir, 1) = Veri(X)
                Yukseklik = Yukseklik + .Cells(Satir, 1).RowHeight
                Satir = Satir + 1
            Next
            
            .Cells.Delete
        End With
        
        If Yukseklik = 0 Then Yukseklik = 15
        Alan.RowHeight = Yukseklik
    Next

    On Error Resume Next
    S1.Delete
    On Error GoTo 0
    
    Set S1 = Nothing

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

 

[bkr-ylmz]

Hocam merhaba,
Ekteki gibi uyguladım ama hiç değişiklik olmadı, acaba kodu yanlış yere mi yazıyorum.

 

[Korhan Ayhan]

Kodu boş bir modüle uyguladıktan butona atayıp kullanabilirsiniz.

 

[bkr-ylmz]

Kod birleşmiş ABC kolonlarında çalışmıyor, birleşmiş DEF de çalışıyor.

 

[Korhan Ayhan]

A-B-C sütunlarında başlık olduğu için sabit olacağını düşünmüştüm. Bu sebeple kodlara dahil etmedim.