Soru Birleştirilmiş Hücrede Girilen Veriye Göre Satır Genişlemesi

[Hsn55]

İyi geceler;
Ekli örnek dosyada Veri Sayfasında Textbox1 e girilen veri girip butona bastığımızda Harita sayfasında S5:Y5 birleştirilmiş hücrede girilen veri kadar SATIR genişlemesi yapabilir miyiz ?

İndir Örnek

Dosyayı indir Örnek

dosya.co

 

[Korhan Ayhan]

Merhaba,

Bu konuyla ilgili bolca örnek var. İnceleyiniz.

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

 

[Hsn55]

Korhan hocam iyi geceler;
Paylaşmış olduğunuz linkte bir örnek buldum. Bu örnekte sadece S5 hücresinde birleştirme yapmadığım zaman işimi görüyor. Fakat hücreleri s5:Y5 olarak birleştirdiğim zaman olmuyor.

Sub Satır_Yükseklik()

Dim S1 As Worksheet, S2 As Worksheet
On Error Resume Next
Set S1 = Worksheets("VERİ")
Set S2 = Worksheets("HARİTA")

S2.Range("S5").RowHeight = 15
S2.Range("S5").WrapText = False
S2.Range("S5") = Sayfa1.TextBox1.Value
S2.Range("S5").WrapText = True
S2.Range("S5").Rows.AutoFit

End Sub

 

[Korhan Ayhan]

Birçok örnek var. Lütfen deneyiniz.

 

[Hsn55]

Hocam denedim. Fakat örnekleri dosyama uygulayamadım

 

[Korhan Ayhan]

Deneyiniz.

Benim excelde Türkçe karakter sorunu olduğu için sayfa isimlerini değiştirmek zorunda kaldım. Siz kendinize göre düzenlersiniz.

Sub Kaydet()
    Dim S1 As Worksheet, S2 As Worksheet
   
    On Error Resume Next
    Set S1 = Worksheets("VERI")
    Set S2 = Worksheets("HARITA")
   
    S2.Range("S5") = Sayfa1.TextBox1.Value
    S2.Range("S5").WrapText = True
    S2.Range("S5").HorizontalAlignment = xlCenter

    Call Satir_Yuksekligi_Ayarla

    Set S1 = Nothing
    Set S2 = Nothing
End Sub

Sub Satir_Yuksekligi_Ayarla()
    Dim Sh As Worksheet, Genislik As Integer, Yukseklik As Integer
    Dim Veri As Variant, Satir As Integer, X As Integer

    Application.ScreenUpdating = False
    Genislik = Sheets("HARITA").Range("S5:Y5").Columns.Width

    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets("Test").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
   
    Sheets.Add
    Set Sh = ActiveSheet
    Sh.Name = "Test"
   
    Satir = 2

    Application.DisplayAlerts = False

    With Sh
        .Cells.Font.Size = Sheets("HARITA").Range("S5").Font.Size
        .Range("A1") = Sheets("HARITA").Range("S5").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
    End With

    If Yukseklik = 0 Then Yukseklik = 15
    Sheets("HARITA").Range("S5:Y5").RowHeight = Yukseklik
   
    On Error Resume Next
    Application.DisplayAlerts = False
    Sh.Delete
    Application.DisplayAlerts = True
    On Error GoTo 0

    Set Sh = Nothing

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

 

[Hsn55]

Korhan bey çok teşekkür ederim

 

[Hsn55]

Korhan bey merhabalar;
Hücre biçimlendirmesini
Yatay:İki Yana Yasla
Dikey:Orta olarak yapabilir miyiz?

 

[Korhan Ayhan]

Bu tarz basit düzenlemeler için bizleri beklemenize gerek yok.

Makro kaydet yöntemiyle ile ilgili kodları elde edip makroya adapte edebilirsiniz.