• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Birleştirilmiş Hücrede Satır Yüksekliği Belirlemek

  • Konbuyu başlatan Konbuyu başlatan mumunal
  • Başlangıç tarihi Başlangıç tarihi
Katılım
5 Mayıs 2005
Mesajlar
60
Merhabalar, Satır yüksekliği ile açılmış konuları inceledim, aralarında;

Private Sub Worksheet_Change(ByVal Target As Range)
If Len(Range("A1").Value) < 10 Then [a1].RowHeight = 15
If Len(Range("A1").Value) > 10 Then [a1].RowHeight = 30
End Sub

Kodu biraz daha kullanılabilir. Fakat;

Yukarıdaki kod hücre içindeki karakter sayısını baz alarak satır yüksekliğini ayarlıyor. Fakat, benim birleştirilmiş hücremde satır yüksekliği için baz almak istediğim kriter bu hücre içindeki satır sayısıdır Örnek tablo EK tedir. Teşekkür ederim.
 
Son düzenleme:
Aşağıdakileri, Sayfa2'nin kod sayfasına kopyalayınız.

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rg As Range
Dim hcr As Range
Dim satirsayisi As Long
Dim satiryuksekligi As Long
Dim bir_sat_yuk As Long
If Not Intersect(Target, [C:C]) Is Nothing Then
   On Error GoTo hata
   Set rg = Target.MergeArea
   satirsayisi = rg.Rows.Count
   bir_sat_yuk = rg.RowHeight
   Application.EnableEvents = False
   Cells(65536, 3) = Target
   Rows(65536).EntireRow.AutoFit
   satiryuksekligi = Rows(65536).RowHeight
   If satiryuksekligi > bir_sat_yuk Then
      For Each hcr In rg.Rows
           hcr.RowHeight = satiryuksekligi / satirsayisi
      Next
   End If
End If
hata:
Set rg = Nothing
Rows(65536).Delete
Application.EnableEvents = True
End Sub
 
Tekrar teşekkürler ama :) hücreye direk olarak giriş yapıldığı zaman yada hücre içinden satır silindiği zaman çalışıyor.

Bir başka hücreden veri aktarıldığında yada hücre içindeki veri silindiğinde herhangi bir değişiklik olmuyor.
 
Private Sub Worksheet_Change(ByVal Target As Range)
If Len(Range("A1").Value) < 10 Then [a1].RowHeight = 15
If Len(Range("A1").Value) > 10 Then [a1].RowHeight = 30
End Sub

Yukarıdaki kodu tabloma uyarlamak istiyorum fakat başarılı olamadım.
Bu kod, hedef hücre içindeki karekter sayısını kriter olarak alıyor.
Ben ise hedef hücre içindeki rakamı kriter olarak almak istiyorum.
 
Aşağıdaki kodları deneyiniz.

Kod:
Private Sub Worksheet_Calculate()
Call Worksheet_Change
End Sub
'-----------------------
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [C:C]) Is Nothing Then
    If Target.Text = "" Then
        Call SatirYuksekligi(Target, 12.75)
    Else
        If Application.CutCopyMode Then
            deger = ActiveCell.Text
        Else
            deger = Target.Text
        End If
        
            Application.EnableEvents = False
            Cells(65536, 3) = deger
            Rows(65536).EntireRow.AutoFit
            If Rows(65536).RowHeight > 12.75 + 12.75 Then
                Call SatirYuksekligi(Target, Rows(65536).RowHeight / 2)
            Else
                Call SatirYuksekligi(Target, 12.75)
            End If
        Application.EnableEvents = True
    End If
End If
End Sub
'----------------------
Sub SatirYuksekligi(hcr As Range, yukseklik As Long)
    hcr.RowHeight = yukseklik
    Cells(hcr.Row + 1, hcr.Column).RowHeight = yukseklik
End Sub
 
Sizi me&#351;gul ediyorum tekrar ama;
Son kodunuz C s&#252;tununda sorunsuz &#231;al&#305;&#351;&#305;yor. Bir ba&#351;ka s&#252;tun i&#231;in uygulamak istedi&#287;imde [C:C]'yi de&#287;i&#351;tirmem yeterli olmuyor. Farkl&#305; s&#252;tunlara uygulamak istedi&#287;imde hangi de&#287;erleri de&#287;i&#351;tirmem gerekiyor. Te&#351;ekk&#252;rler.
 
"C" sütunu sizinde bildiğiniz gibi özel bir sütun. Yani, birleştirilmiş hücreler içeriyor. Onun için özel bir prosedür yazıldı. Diğer sütunlarda, bu nedenle çalışması mümkün değil.

Eğer, örneğin "D" sütununda çalışmasını istiyorsanız, öncelikle [C:C] yazan yeri [D: D] olarak değiştirin. Daha sonra da parametrik çağrılan prosedürü şu şekilde değiştirin.

Kod:
Sub SatirYuksekligi(hcr As Range, yukseklik As Long)
    hcr.RowHeight = yukseklik [COLOR=red][B]* 2
[/B][/COLOR][COLOR=green]'    Cells(hcr.Row + 1, hcr.Column).RowHeight = yukseklik[/COLOR]
End Sub

Hem "C" de hem "D"de çalışsın derseniz, modulü yeniden yapılandırmamız gerekir. Onun için, ihtiyaçlarınızı net olarak belirleyiniz.
 
Birleştirilmiş hücrelerde kullanmak istiyorum, yardım almak üzere örnek olarak verdiğim tabloda birleştirilmiş hücreler tesadüfen C sütununa geldi.

C sütunu nasıl ise bu kodu uygulamak istediğim örneğin J sütunu da aynı.

Sub SatirYuksekligi(hcr As Range, yukseklik As Long)
hcr.RowHeight = yukseklik * 2
' Cells(hcr.Row + 1, hcr.Column).RowHeight = yukseklik
End Sub
Bu kodu sanırım birleştirilmemiş hücreler için hazırladınız.

Sizden ricam birleştirilmiş C sütunu hücreleri için geçerli olan bu kodu, yine aynı şekilde birleştirilmiş bir başka sütunun hücreleri için uygularken [C:C] dışında hangi değişiklikleri yapacağım.

Çok değişken parametler içeriyor ise sizden K sütunu için hangi değerleri gireceğimi öğrenebilir miyim. Teşekkür ederim.
 
"K" sütununa göre kodları değiştirdim. Ekteki dosyayı inceleyiniz.

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [K:K]) Is Nothing Then
    If Target.Text = "" Then
        Call SatirYuksekligi(Target, 12.75)
    Else
        If Application.CutCopyMode Then
            deger = ActiveCell.Text
        Else
            deger = Target.Text
        End If
        
            Application.EnableEvents = False
            Cells(65536, "K") = deger
            Rows(65536).EntireRow.AutoFit
            If Rows(65536).RowHeight > 12.75 + 12.75 Then
                Call SatirYuksekligi(Target, Rows(65536).RowHeight / 2)
            Else
                Call SatirYuksekligi(Target, 12.75)
            End If
            Rows(65536).Delete
        Application.EnableEvents = True
    End If
End If
End Sub
'-------------------------------
Sub SatirYuksekligi(hcr As Range, yukseklik As Long)
    hcr.RowHeight = yukseklik
    Cells(hcr.Row + 1, hcr.Column).RowHeight = yukseklik
End Sub
 
Birleştirilmiş hücrede satır yüksekliği ayarlayacak kod forumda hiç yok ilgili konular var ama kesin sonuç yok
 
Geri
Üst