Metne göre satır yüksekliği

[omeryılmaz]

Değerli Arkadaşlar..! Hayırlı çalışmalar dileğiyle..

Birleştirilmiş hücrede, metnin hacmine göre, satır yüksekliğinin otomatik olarak ayarlanması konusunda bir çok çalışma inceledim ancak tam olarak örnek dosyamda mevcut 15. satıra uyarlayamadım.
yardımlarınız için şimdiden şükranlarımı sunuyorum..

 

[Skorpiyon]

Sayın omeryilmaz,

İşinizi görürse aşağıdaki şekilde kullanabilirsiniz.

 

[omeryılmaz]

Sayfada A15 hücresine girilen harf karakter sayısına göre satır yüksekliğini ayarlamak daha doğru olmazmı?

 

[Skorpiyon]

Aklıma gelmedi değil, ama paragraf ile başlarsanız bunu ayarlamak sorun olmaz mı ? Sizin metninizde 1'den fazla paragraf var.

 

[ormann]

Sayın Şaban UZUN ekteki örnek dosyada butonu tıkladığımda girilen metne göre satır genişliyo ve daralıyo .Benim istediğim bunu sadece a4 sayfasında a12 satırıyla sınrlayabilirmiyiz.? yani diğer hücereleride birleştirdiğim zaman işlem a12 satırında yapacak .makro aktif olacak.Ben diğer hücreleri birleştirdiğim zaman makro çalışmıyo

 

[Korhan Ayhan]

Selamlar,

Ekteki örnek dosyayı incelermisiniz. Sarı renkli hücrenizdeki metnin yapısını biraz değiştirmek zorunda kaldım. Bu şekilde sorun çıkarmaz diyorsanız önerdiğim kod işinize yarayacaktır.

Uygulanan kod; (Sayfanın kod bölümüne uygulayınız.)

Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim S1 As Worksheet, GENİŞLİK As Integer, YÜKSEKLİK As Integer
    Dim VERİ As Variant, Satır As Integer, X As Integer
    
    If Intersect(Target, Range("A15:Q15")) Is Nothing Then Exit Sub
    
    Application.ScreenUpdating = False
    GENİŞLİK = Range("A15:Q15").Columns.Width
    
    Set S1 = Sheets.Add
    Satır = 2
    
    Application.DisplayAlerts = False
    
    With S1
        .Cells.Font.Size = Target.Font.Size
        .Range("A1") = "=Sayfa31!A15"
        .Range("A:A").WrapText = True
        .Range("A1").VerticalAlignment = xlJustify
        .Range("A1").ColumnWidth = GENİŞLİK / 5.3
        .Range("A1").EntireRow.AutoFit
         
        VERİ = Split(.Range("A1"), Chr(10))
    
        For X = 0 To UBound(VERİ)
            .Cells(Satır, 1) = VERİ(X)
            YÜKSEKLİK = YÜKSEKLİK + .Cells(Satır, 1).RowHeight
            Satır = Satır + 1
        Next
        
        .Delete
    End With
    
    Target.RowHeight = YÜKSEKLİK
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

 

[Korhan Ayhan]

Selamlar,

Sn. ormann,

Dosyanızda tüm kodları silin ve aşağıdaki kodu "a5" isimli sayfanızın kod bölümüne uygulayın. Yeşil renkli hücreye veri girişi yapıp enter tuşuna bastığınızda işlem gerçekleşecektir.

Sayın Şaban UZUN ekteki örnek dosyada butonu tıkladığımda girilen metne göre satır genişliyo ve daralıyo .Benim istediğim bunu sadece a4 sayfasında a12 satırıyla sınrlayabilirmiyiz.? yani diğer hücereleride birleştirdiğim zaman işlem a12 satırında yapacak .makro aktif olacak.Ben diğer hücreleri birleştirdiğim zaman makro çalışmıyo

Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim GENİŞLİK As Integer, YÜKSEKLİK As Integer
    Dim VERİ As Variant, S1 As Worksheet, X As Integer, Satır As Long
 
    If Intersect(Target, Range("B4:F18")) Is Nothing Then Exit Sub
 
    Application.ScreenUpdating = False
 
    GENİŞLİK = Range("B4:F4").Columns.Width
 
    Set S1 = Sheets.Add
    Satır = 2
 
    Application.DisplayAlerts = False
 
    With S1
        .Cells.Font.Size = Target.Font.Size
        .Range("A1") = "=a5!B4"
        .Range("A:A").WrapText = True
        .Range("A1").VerticalAlignment = xlJustify
        .Range("A1").ColumnWidth = GENİŞLİK / 5.3
        .Range("A1").EntireRow.AutoFit
 
        VERİ = Split(.Range("A1"), Chr(10))
 
        For X = 0 To UBound(VERİ)
            .Cells(Satır, 1) = VERİ(X)
            YÜKSEKLİK = YÜKSEKLİK + .Cells(Satır, 1).RowHeight
            Satır = Satır + 1
        Next
 
        .Delete
    End With
 
    Sheets("a4").Select
    Sheets("a4").Range("A12").RowHeight = YÜKSEKLİK
    ActiveSheet.PrintPreview
 
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

 

[ormann]

Korhan Bey çok teşekkür ederim ellerinize sağlık

 

[omeryılmaz]

Korhan Hocam Eline Yüreğine Sağlık......Teşekkürler