Leere Zeilen / Zeilenumbruch aus Textfeld entfernen

[Frank77]

Hallo!
Ich konnte durch ein bisschen recherchieren das mit den 79 Zeichen pro Zeile, durch ein erzwingen eines automatischen Zeilenumbruch bei Eingabe Lössen
Ob das so völlig richtig ist weiß ich jetzt nicht aber es funktioniert ohne Fehler

Ich werde versuchen das alles zusammen zu basteln
Gruß Frank 

Code [Auswählen] Erweitern

Private Sub TextBox1_Change()
    Dim TextArray As Variant
    Dim Index As Integer
    Dim vntTextArray As Variant
    Dim intIndex As Integer

    TextArray = Split(TextBox1.Text, vbCrLf)
    For Index = 0 To UBound(TextArray)
        If Len(TextArray(Index)) > 79 Then

            vntTextArray = Split(TextBox1.Text, vbCrLf)
            For intIndex = 0 To UBound(vntTextArray)
                If Len(vntTextArray(intIndex)) > 79 Then _
                   vntTextArray(intIndex) = Left$(vntTextArray(intIndex), 79) & _
                   vbCrLf & Mid$(vntTextArray(intIndex), 80)
            Next intIndex
            TextBox1.Text = Join(vntTextArray, vbCrLf)
            Me!TextBox1.SelStart = Len(Me!TextBox1.Text)
        End If
    Next Index
End Sub


[Frank77]

Hallo!

Habs jetzt fertig dank eurer Hilfe

Button aus Unterformular zum hinzufügen des Textes und kontrollieren des Felds  der auch in eine Leerzeile schreibt

Code [Auswählen] Erweitern

If Nz(strVeranstaltung) <> "" Then
                        strString = Forms!FrmVeranstaltungsBewerbungen!TxtBewerbungBetreff
                        If InStr(1, strString, strVeranstaltung, vbTextCompare) = 0 Then
                            S = Forms!FrmVeranstaltungsBewerbungen!TxtBewerbungBetreff.Value & Chr(13) & Chr(10) & strVeranstaltung
                            If Left$(S, 2) = vbCrLf Then S = Mid$(S, 3)
                            Forms!FrmVeranstaltungsBewerbungen!TxtBewerbungBetreff = Replace(S, vbCrLf & vbCrLf, vbCrLf)
                            Forms!FrmVeranstaltungsBewerbungen!TxtBewerbungBetreff.SetFocus
                            Forms!FrmVeranstaltungsBewerbungen.BewerbungBetreffPrüfen
                        End If
                    End If

Externes Modul:

Code [Auswählen] Erweitern


Public Function UmbruchRaus(ByVal MemoRein As String)
    Dim Position As Integer
    If Left$(MemoRein, 2) = vbCrLf Then MemoRein = Mid$(MemoRein, 3)
    Do While InStr(MemoRein, vbCrLf & vbCrLf) <> 0     'Umbruch da
        Position = InStr(MemoRein, vbCrLf & vbCrLf)
        MemoRein = Left$(MemoRein, Position - 1) + Mid$(MemoRein, Position + 2)
    Loop
    UmbruchRaus = MemoRein
End Function

Hilfs Prozedur für den Aufruf aus Unterformular

Code [Auswählen] Erweitern

Sub BewerbungBetreffPrüfen()
    Call TxtBewerbungBetreff_Change
End Sub

Im Testfeld selber:

Code [Auswählen] Erweitern


Private Sub TxtBewerbungBetreff_Change()
    Dim str As String
    Dim Msg As String
    Dim sf() As String
    Dim TextArray As Variant
    Dim Index As Integer
    Dim vntTextArray As Variant
    Dim intIndex As Integer

    str = Me!TxtBewerbungBetreff.Text
    str = UmbruchRaus(str)

    ' Zeilenumbruch bei Eingabe
    TextArray = Split(str, vbCrLf)
    For Index = 0 To UBound(TextArray)
        If Len(TextArray(Index)) > 79 Then

            vntTextArray = Split(str, vbCrLf)
            For intIndex = 0 To UBound(vntTextArray)
                If Len(vntTextArray(intIndex)) > 79 Then _
                   vntTextArray(intIndex) = Left$(vntTextArray(intIndex), 79) & _
                   vbCrLf & Mid$(vntTextArray(intIndex), 80)
            Next intIndex
            Me!TxtBewerbungBetreff = Join(vntTextArray, vbCrLf)
            Me!TxtBewerbungBetreff.SelStart = Len(Me!TxtBewerbungBetreff.Text)
        End If
    Next Index

    ' Maximale länge festlegen
    If Len(str) > 241 Then
        Msg = "  Der Text darf nur 241 Zeichen lang sein" & vbCr & "und wurde deshalb auf diese länge gekürzt!"
        MsgBox Msg, vbInformation Or vbOKOnly, "Nicht zulässig!"
        Me!TxtBewerbungBetreff.Text = Left(str, 241)
        Me!TxtBewerbungBetreff.SelStart = Len(Me!TxtBewerbungBetreff.Text)
    End If

    'Maximale Zeilenumbrüche festlegen
    If Len(str) > 0 Then
        sf() = Split(str, vbCrLf)
        If UBound(sf()) > 2 Then
            Msg = "Es dürfen für den betreff maximal 3 Zeilen verwendet werden"
            MsgBox Msg, vbInformation Or vbOKOnly, "Nicht zulässig!"
            ReDim Preserve sf(2)
            Me!TxtBewerbungBetreff = Join(sf(), vbCrLf)
            Me!TxtBewerbungBetreff.SelStart = Len(Me!TxtBewerbungBetreff.Text)
        End If
    End If
End Sub

Gruß Frank