Textbox da alt satıra geçince 2 karakter sayma

kadir78

Altın Üye
Katılım
6 Nisan 2016
Mesajlar
227
Excel Vers. ve Dili
office 2019
Altın Üyelik Bitiş Tarihi
30-12-2026
İyi günler. Aşağıdaki kodlar ile textbox1 içinde bulunan karakter sayısını saydırıyorum fakat bir sorunu çözemedim. Textbox1 içerisinde alt satıra enter ile geçince 2 karakter sayıyor. Bu 2 karakterin sayılmasını engellemek istiyorum fakat çok araştırdım bir çözüm bulamadım. Yardımcı olurmusunuz.

EnterKeyBehavior = True
MultiLine = True

Kod:
Private Sub TextBox1_Change()
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim mytext As String, mytext2 As String
Dim lines() As String
Dim i As Integer
Dim maxlen As Integer

If Len(TextBox1.Value) > 100 Then
    TextBox1.Value = Left(TextBox1.Value, 100)
    MsgBox "En Fazla 100 Karakter Yazılabilir !", vbInformation
Else
    lines = Split(TextBox1.Value, vbCrLf)
    If UBound(lines) > 4 Then
        On Error GoTo git
        mytext = Me.TextBox1.Value
        lines() = Split(mytext, vbNewLine)
        ReDim Preserve lines(UBound(lines) - 1)
        mytext = Join(lines, vbNewLine)
        Me.TextBox1.Value = mytext
        MsgBox "En Fazla 5 Satır Yazılabilir !", vbInformation
    End If
End If

mytext2 = Me.TextBox1.Value
lines() = Split(mytext2, vbNewLine)
maxlen = 20

For i = LBound(lines) To UBound(lines)
    lines(i) = Left(lines(i), maxlen)
Next i
mytext2 = Join(lines, vbNewLine)
Me.TextBox1.Value = mytext2

Label5.Caption = 100 - Len(TextBox1.Value) & " - " & Len(mytext2)
git:

End Sub
 
Son düzenleme:

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,246
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Aşağıdaki yapıyı kendi kodlarınıza uyarlamayı deneyiniz.

Ben örnek olsun diye MSGBOX üzerinde kontrolü gösterdim. Siz uyarlamasını yaparsınız.

C++:
Private Sub CommandButton1_Click()
    MsgBox Len(Replace(TextBox1, vbNewLine, ""))
End Sub
 

kadir78

Altın Üye
Katılım
6 Nisan 2016
Mesajlar
227
Excel Vers. ve Dili
office 2019
Altın Üyelik Bitiş Tarihi
30-12-2026
Aşağıdaki yapıyı kendi kodlarınıza uyarlamayı deneyiniz.

Ben örnek olsun diye MSGBOX üzerinde kontrolü gösterdim. Siz uyarlamasını yaparsınız.

C++:
Private Sub CommandButton1_Click()
    MsgBox Len(Replace(TextBox1, vbNewLine, ""))
End Sub
Korhan hocam çok teşekkür ederim. Emeğinize sağlık olsun sağolun. En son aşağıdaki gibi uyarladım.

Kod:
Private Sub TextBox1_Change()
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim yazi As String
Dim lines() As String
Dim snc As Integer
Dim str As String
Dim i As Integer
Dim ks As Integer
Dim ku As String
yazi = Me.TextBox1.Value
ks = 20
ku = Me.TextBox1.Value

On Error Resume Next

If Len(TextBox1.Value) > 108 Then
    Me.TextBox1.Value = Left(Me.TextBox1.Value, 108)
    MsgBox "En Fazla 100 Karakater Yazılabilir !", vbInformation, "Hata"
    GoTo git
Else
    lines = Split(yazi, vbNewLine)
    If UBound(lines) > 4 Then
        ReDim Preserve lines(UBound(lines) - 1)
        yazi = Join(lines, vbNewLine)
        Me.TextBox1.Value = yazi
        MsgBox "En Fazla 5 Satır Yazılabilir !", vbInformation, "Hata"
        GoTo git
    End If
End If

lines = Split(Me.TextBox1.Text, vbCrLf)
For i = LBound(lines) To UBound(lines)
    str = str & "Satır " & (i) + 1 & "  :  " & Len(lines(i)) & vbCrLf
Next i
Label6.Caption = str

lines() = Split(ku, vbNewLine)
For j = LBound(lines) To UBound(lines)
    lines(j) = Left(lines(j), ks)
Next j

ku = Join(lines, vbNewLine)
Me.TextBox1.Value = ku
Label5.Caption = Len(Replace(TextBox1, vbNewLine, ""))

git:
End Sub
 
Son düzenleme:
Üst