Taşıt görev emri formu

[Muhammet Okumuş]

Şu kodları ayrı ayrı dener misiniz. Önce A14 satır yüksekliğini 15 yapın. Web ile başlayan satır 48. satır olsun.

Sub A4_Küçült()
b = 3
10
sat = Cells(Rows.Count, 1).End(3).Row
x = 797.25
a = Range("A1:A" & sat).Rows.Height

If a > x Then
If WorksheetFunction.CountA(Range("A" & sat - b & ":M" & sat - b)) = 0 Then
Rows(sat - b).Delete
Else
b = b + 1
GoTo 10
End If
GoTo 10
End If
End Sub

Sub A4_Büyüt()
10
sat = Cells(Rows.Count, 1).End(3).Row
x = 782
a = Range("A1:A" & sat).Rows.Height
If a < x Then
Rows(sat - 2).Insert
GoTo 10
End If
End Sub

 

[sefaburan]

hocam muhteşem oldu vallahi. şimdi bunu tüm sayfalara uygulayacağım. şimdilik tek sorunum kaldı o da ben yazı yazdığımda 14. satırın yazının uzunluğuna ya da kısalığına göre yükselip daralması. bunu da halledebilirsem çok süper olacak. şimdi onunla uğraşacağım. çok çok teşekkür ediyorum. ALLAH razı olsun çok uğraştın.

 

[sefaburan]

işte son hali: http://www.dosya.tc/server36/UJLlvg/ResmiYaz__.rar.html

 

[Muhammet Okumuş]

Tek koda indirilmiş hali

Sub A4_Ayarla()
Application.ScreenUpdating = False
b = 3
10
sat = Cells(Rows.Count, 1).End(3).Row
x = 797.25
a = Range("A1:A" & sat).Rows.Height

If a > x Then
If WorksheetFunction.CountA(Range("A" & sat - b & ":M" & sat - b)) = 0 Then
Rows(sat - b).Delete
Else
b = b + 1
GoTo 10
End If
GoTo 10
End If

20
sat = Cells(Rows.Count, 1).End(3).Row
x = 782
a = Range("A1:A" & sat).Rows.Height
If a < x Then
Rows(sat - 2).Insert
GoTo 20
End If


End Sub

 

[Muhammet Okumuş]

Satır yüksekliğini en uygun satır yüksekliği olarak belirleyin.(Kaydır aktif olmalı)