Satır Yüksekliği

[Ridan]

Aşağıda basit bir kod yaptım. Bu kodu tüm sayfalar için uygulamak istiyorum. Bu işlemi B ile M arası yapıyorum. Bu ara birleştirilmiş hücreler içeriyor. Yardımlarınızı bekliyorum.

(N14'e 2 yazıyorum, satır iki katı, 3 yazıyorum satır 3 katı yüksek oluyor.)

Private Sub Worksheet_Change(ByVal Target As Range)

If Range("N14").Value = 1 Then Rows("14:14").RowHeight = 15.75
If Range("N14").Value = 2 Then Rows("14:14").RowHeight = 15.75 * 2
If Range("N14").Value = 3 Then Rows("14:14").RowHeight = 15.75 * 3
If Range("N14").Value = 4 Then Rows("14:14").RowHeight = 15.75 * 4

If Range("N15").Value = 1 Then Rows("15:15").RowHeight = 15.75
If Range("N15").Value = 2 Then Rows("15:15").RowHeight = 15.75 * 2
If Range("N15").Value = 3 Then Rows("15:15").RowHeight = 15.75 * 3
If Range("N15").Value = 4 Then Rows("15:15").RowHeight = 15.75 * 4

............... satır 31'e kadar devam ediyor.

End Sub

 

[Ömer BARAN]

Merhaba.

Umarım yanlış anlamadım.

VBA ekranında sol taraftan Bu ÇalışmaKitabı(ThisWorkbook)'na fareyle çift tıklayın,
sağdaki boş alana aşağıdaki kod'u yapıştırın.

-- Tüm sayfalarda N sütununa yazacağınız sayı*15.75 ilgili satırın yüksekliği olacaktır.
-- Sadece 14-31 satır aralığında değil de tüm satırlarda N sütununa sayı yazarak işlem yapmak istiyorsanız kırmızı kısmı silin.
.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
[B][COLOR="Blue"]If Not IsNumeric(Target) Then Exit Sub[/COLOR][/B]
If Target.Column = 14 And Target.Value > 0 [COLOR="Red"]And Target.Row >= 14 And Target.Row <= 31[/COLOR] Then _
    Rows(Target.Row).RowHeight = Target * 15.75
End Sub

SONRADAN İLAVE NOT:
Yukarıdaki kod'a eklediğim mavi renklendirilmiş kısım, N sütununa sayısal olmayan değer girildiğinde oluşacak hatayı engelleyecektir.
.

 

[ÖmerBey]

Merhaba,
Alternatif olsun. ThisWorkbook kod bölümüne aşağıdaki kodu kopyalayınız.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Intersect(Sh.Range("N14:N31"), Target) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
yuk = Target.Value
If Not IsNumeric(yuk) Then
    GoTo sil
Else
    If yuk > 0 And yuk < 26 Then
        Target.EntireRow.RowHeight = 15.75 * yuk
    Else
        GoTo sil
    End If
End If
Exit Sub
sil:
MsgBox "Geçerli bir sayı girmediniz.", vbCritical
Application.EnableEvents = False
Target.ClearContents
Application.EnableEvents = True
End Sub

 

[Ridan]

Cevaplarınız için çok teşekkürler.