Her hücreye bir harf!

[ofbalki]

Sayın ustalarım;

Bir TextBox kutusuna yazdığımız kelimenin her harfini bir hücreye yazacak bir kod varmı?

Sitede aradım ama bulamadım. Eğer vardı da ben bulamamışsam özür diliyorum. Acemiliğime verin.

Örnek: TextBox1 e "excel web tr" yazdık. Sayfa1 de A1 den J1 e kadar, boşluklar dahil her hücreye bir karekter gelecek şekilde yazdıracağız. Fazla olan karekterler kalacak.

Yardımlarınızı bekliyorum.

Selam ve Dua ile...

 

[Orion1]

İşte kodlar.

Private Sub CommandButton1_Click()
Dim i As Byte, k As Byte
Range("A1:J1").ClearContents
If TextBox1.Value = "" Then Exit Sub
If Len(TextBox1.Value) > 10 Then
    k = 10
    Else
    k = Len(TextBox1.Value)
End If
For i = 1 To k
    Cells(1, i).Value = Mid(TextBox1.Value, i, 1)
Next i
End Sub

 

[ofbalki]

Teşekkürler sayın Evren Gizlen, gerçekten harika, ellerinize sağlık.

Yalnız soruda yazmayı untmuşum. Ben bunu okul programında kullanacağı. Bunedenle programda birçok sayfa var. sayfa seçtirerek yaptırmam gerekiyor. Birde buna bakabilirmisiniz.

 

[Orion1]

Sayfa adını kendi dosyanıza göre değiştiriniz.

Private Sub CommandButton1_Click()
Dim i As Byte, k As Byte
[B][COLOR="Red"]sheets("Sayfa1").select[/COLOR][/B]
Range("A1:J1").ClearContents
If TextBox1.Value = "" Then Exit Sub
If Len(TextBox1.Value) > 10 Then
    k = 10
    Else
    k = Len(TextBox1.Value)
End If
For i = 1 To k
    Cells(1, i).Value = Mid(TextBox1.Value, i, 1)
Next i
End Sub

 

[ofbalki]

Eyvallah kardeş.

 

[ofbalki]

Sayın Evren Gizlen, benim kayıt formumda ismin yazılacağı yer "G2828" hücreleri.

Ben bu araya yazdırabilirim sanmıştım ama beceremedim. Demekki almamız gereken daha çok yol var. Siz bu konuda da bi yardımcı olsanız.

Lütfen kızmayın, beceremedim napiim.

Selam ve Dua ile...

 

[ECYavuz]

Sayın Evren hocamın izni ile; Eğer doğru anladıysam kodu aşağıdaki gibi değiştiriniz.

Private Sub CommandButton1_Click()
Dim i As Byte, k As Byte
sheets("Sayfa1").select
Range("G2828").ClearContents
If TextBox1.Value = "" Then Exit Sub
If Len(TextBox1.Value) > 10 Then
k = 10
Else
k = Len(TextBox1.Value)
End If
For i = 1 To k
Cells(28, i + 6).Value = Mid(TextBox1.Value, i, 1)
Next i
End Sub

 

[ofbalki]

Eyvallah kardeş, Allah razı olsun. Tam istediğim gibi olmuş.

Böyle kardeşlerim oldukça benim sırtım asla yere gelmez.

Selam ve Dua ile...