hücre satır genişliği hk

[Korhan Ayhan]

A1 hücresi için aşağıdaki örnek kodu kullanabilirsiniz. Kodun hangi satırı işinize yarıyorsa onu kullanırsınız.

Sub TEST()
    Range("A1").EntireRow.AutoFit 'Satır yüksekliği otomatik
    Range("A1").EntireColumn.AutoFit 'Sütun genişliği otomatik
End Sub

 

[mhmt_07]

Korhan bey iyi günler bir sayıyı birleştirilmiş bir hücrede aşağıdaki formülü kullanarak yazıya çeviriyorum kullandığım formüle yeni kod yazarak metnin ilgili hücreye sığmasını ayarlayabilir miyiz. Yardımlarınız için şimdiden teşekkürler.

Function Yaziyla(Sayi#)
Dim virgul2 As String
Dim cevap As String
Dim yazi As String
Dim Say As String
Dim uclu As String
Dim virgul As Integer
Dim o As Integer
Dim b As Integer
Dim X As Integer
Dim i As Integer
Dim y As Integer
Dim TL As String
Dim Kr As String

If Sayi# = 0 Then Yaziyla = "  ": Exit Function

ReDim birler$(10), onlar$(10), BASAMAK$(5)

birler$(0) = "": birler$(1) = "bir"
birler$(2) = "iki": birler$(3) = "üç"
birler$(4) = "dört": birler$(5) = "beş"
birler$(6) = "altı": birler$(7) = "yedi"
birler$(8) = "sekiz": birler$(9) = "dokuz"

onlar$(0) = "": onlar$(1) = "on"
onlar$(2) = "yirmi": onlar$(3) = "otuz"
onlar$(4) = "kırk": onlar$(5) = "elli"
onlar$(6) = "altmış": onlar$(7) = "yetmiş"
onlar$(8) = "seksen": onlar$(9) = "doksan"

BASAMAK$(1) = "": BASAMAK$(2) = "bin "
BASAMAK$(3) = "milyon ": BASAMAK$(4) = "milyar "
BASAMAK$(5) = "trilyon "

virgul2 = ""
cevap = ""

'AŞAĞIDAKİ 2 SATIRDAKİ ÇİFT TIRNAK İÇERİĞİNİ DEĞİŞTİREREK
'VEYA ÇİFT TIRNAĞIN ARASINI SİLEREK "" VEYA "," GİBİ
'İSTEĞİNİZ SONUCUN ÇIKMASINI SAĞLAYABİLİRSİNİZ.
TL = "-TL, "
Kr = "-Kr."

Say = Str$(Sayi#)
virgul = InStr(1, Say, ".")
If virgul Then

'Aşağadaki satır 26,4 Yirmialtı TL, KIRK Kr olarak okutur.
' (Yirmialtı TL, DÖRT Kr olarak değil)
'İptal etmek isterseniz başına bir ' tek tırnak işareti koyunuz
If Len(Mid(Say, virgul + 1)) = 1 Then Say = Say + "0"

Say = Right$(Say, Len(Say) - virgul)
GoSub cevir

If cevap = "" Then Kr = ""
virgul2 = cevap + Kr
cevap = ""

Say = Str$(Sayi#)
Say = Left$(Say, virgul - 1)
End If
GoSub cevir
If cevap = "" Then TL = ""
Yaziyla = cevap + TL + virgul2
Exit Function

cevir:
X = Len(Say)
Say = String$(3 - (X - Int(X / 3) * 3), 48) + Say
X = Len(Say) / 3
For i = 1 To X
uclu = Mid$(Say, Len(Say) - i * 3 + 1, 3)
y = Val(Mid$(uclu, 1, 1))
o = Val(Mid$(uclu, 2, 1))
b = Val(Mid$(uclu, 3, 1))

yazi = ""
If y <> 0 Then
If y > 1 Then yazi = birler$(y)
yazi = yazi + "yüz "
End If

yazi = yazi + onlar$(o) + birler$(b)

If yazi <> "" Then
If LCase(yazi) = "bir" And i = 2 Then yazi = ""
If yazi = "bir" And BASAMAK$(i) = "bin " Then
cevap = BASAMAK$(i) + cevap
Else
cevap = yazi + BASAMAK$(i) + cevap
End If
End If
Next i
If Sayi# < 0 Then cevap = "-Eksi-" + cevap
Return
End Function

 

[Korhan Ayhan]

Verdiğiniz kod kullanıcı tanımlı fonksiyondur. Bu koda bu özellik eklenemez. Harici bir kod ile hücrenin satır ve sütun genişliğini ayarlayabilirsiniz. Bunun içinde örnek kod verdim. Ayrıca konu içinde başka linklerde çözümlerde var. Bunları kendi dosyanıza uyarlamalısınız. Yapamam derseniz dosyanızı eklemelisiniz.

 

[ptcsite]

hücre yüksekliğini otomatik ayarlamak için yazığım kodu sizinle paylaşmak istedim.

a = b / 78 kodundaki 78 rakamı bir satırın aldığı karakter sayısını ifade etmektedir.değiştirilebilir.
iyi çalışmalar dileğiyle

Sub Düğme4_Tıklat()
b = Len([a24])
a = b / 78
'[f6] = a

If a > 32 Then
Rows("24:24").RowHeight = 409.5
Else
Rows("24:24").RowHeight = 12.75 * a
End If
End Sub

Metin Bey süpersiniz. İşe yarıyor...
Kodlamadaki Len([a24]) ne demek ?
Ayrıca bu kodda ben bir kaç satıra uygulatmak istiyorum. Yani düğmeye basınca bir kaç satırda ayar yapacak. Bunun için ;

Sub Düğme4_Tıklat()
b = Len([a24]) Bu kısımda sadece A24 değil A26 A28 A30 hücrelerine de uygulatacam.
a = b / 78
'[f6] = a

If a > 32 Then
Rows("24:24").RowHeight = 409.5 Bu kısımda sadece 24 değil 26 28 30 Satırlarını yazcam
Else
Rows("24:24").RowHeight = 12.75 * a B]Bu kısımda sadece 24 değil 26 28 30 Satırlarını yazcam[/B]
End If
End Sub[/QUOTE]