Hallo !
habe da ein Problem wozu ich auch im Netz noch keine Lösung gefunden habe
Wenn ich in einen Textfeld mit Zeilenumbrüchen einen Inhalt habe der so aus sieht
1. Eintrag
2. Eintrag
3. Eintrag
4. Eintrag
5. Eintrag
6. Eintrag
7. Eintrag
8. Eintrag
9. Eintrag
10. Eintrag
Und der User dann mehrere Zeilen entfernt damit der Eintrag dann so aus sieht
1. Eintrag
3. Eintrag
5. Eintrag
6. Eintrag
7. Eintrag
9. Eintrag
10. Eintrag
Würde ich Gene eine Prozedur erstellen die das Ganze dann wieder aneinander schiebt
Und es dann wieder so aussieht
1. Eintrag
3. Eintrag
5. Eintrag
6. Eintrag
7. Eintrag
9. Eintrag
10. Eintrag
Das Feld wird auf diese Art befühlt
If Nz(strVeranstaltung) <> "" Then
Forms!FrmVeranstaltungsBewerbungen!TxtBewerbungBetreff = Forms!FrmVeranstaltungsBewerbungen!TxtBewerbungBetreff.Value & Chr(13) & Chr(10) & strVeranstaltung
End If
Grus frank
evtl so:
Forms!FrmVeranstaltungsBewerbungen!TxtBewerbungBetreff = Replace(Forms!FrmVeranstaltungsBewerbungen!TxtBewerbungBetreff.Value & Chr(13) & Chr(10) & strVeranstaltung, vbcrlf & vbcrlf, vbcrlf)
Hi!
Danken für die schnelle Antwort! ;D
Werde das dann so hinter meine Button schreiben
Kann ich das auch irgendwie ins After Update des Textfeldes schreiben ?
hab da gerade was gefunden aber da bleiben dann plötzlich nur noch 3 Zeichen stehen
Private Function UmbruchRaus(ByVal MemoRein As String)
Dim Position As Integer
While InStr(MemoRein, vbCrLf) <> 0 'Umbruch da
Position = InStr(MemoRein, vbCrLf)
MemoRein = Left$(MemoRein, Position - 1) + Right$(MemoRein, Position + 2)
Wend
UmbruchRaus = MemoRein
End Function
Gruß frank
ZitatKann ich das auch irgendwie ins After Update des Textfeldes schreiben ?
einfach mal probieren.
Zitathab da gerade was gefunden aber da bleiben dann plötzlich nur noch 3 Zeichen stehen
Dieser Code ist fehlerhaft.
ZitatMemoRein = Left$(MemoRein, Position - 1) + Right$(MemoRein, Position + 2)
Diese zeile führt zu falschen ergebnissen, richtiger wäre
MemoRein = Left$(MemoRein, Position - 1) + Mid$(MemoRein, Position + 2)Das ergbenis wird sein das du alle vbcrlf's aus deinem Text löscht. Das ist ja nicht was du willst.
Du suchst nicht nach einem
vbcrlf sondern zwei, unter der vorraussetzung es befinden sich keine weiteren leerzeichen zw den vbcrlf's
Private Function UmbruchRaus(ByVal MemoRein As String)
Dim Position As Integer
While InStr(MemoRein, vbCrLf & vbcrlf) <> 0 'Umbruch da
Position = InStr(MemoRein, vbCrLf)
MemoRein = Left$(MemoRein, Position - 1) + Mid$(MemoRein, Position + 2)
Wend
UmbruchRaus = MemoRein
End Function
Hi!
Danke, Danke, Danke !!!! ;D ;D ;D
Super Sache nach dem Löschen eines Eintrags schreibt der Button in die leere Zeile war eigentlich nicht beabsichtigt damit lassen sich gleich mal Fehler vermeiden wenn in abfragen oder so geschrieben wird
wieder was dazu gelernt Super
Die Funktion ist genau das was ich gesucht habe Für Notiz Felder oder variablen die ich an Word übergeben möchte
Einfach mal probiert hab ich das so, geht auch
Me!TxtBewerbungBetreff = Replace(Me!TxtBewerbungBetreff.Value & Chr(13) & Chr(10), vbCrLf & vbCrLf, vbCrLf)
Gruß Frank
Danke für die Hilfe
Hallo!
Ein kleines Problem habe ich noch mit dem Code
Wenn ich im Textfeld den ersten Eintrag mit der löschentaste entferne schlägt die Prozedur nicht an
_____________________
1. Eintrag
2. Eintrag
3. Eintrag
_____________________
Das ergebnis ist dann so
_____________________
2. Eintrag
3. Eintrag
_____________________
Ich hab dann versucht das Ergebnis durch Zu geben aber die Zeile stellt auch kein leeres Zeichen dar
Public Function KillBlank(X) As String
Dim Temp$, C$, NeuerString, Gefunden, Anzeigen
Dim i As Integer
Gefunden = False
Anzeigen = False
NeuerString = Null
If IsNull(X) Then
' Wenn kein Inhalt im Feld vorhanden ist,
' wird die Funktion abgebrochen
Exit Function
Else
Temp$ = CStr(X)
For i = 1 To Len(Temp$)
C$ = Mid$(Temp$, i, 1)
If C$ = Chr$(32) Then
If Not Gefunden Then
Gefunden = True
NeuerString = NeuerString & C$
Else
Anzeigen = True
End If
Else
NeuerString = NeuerString & C$
Gefunden = False
End If
Next i
' Das Ergebnis wird an die Funktion wieder übergeben
KillBlank = NeuerString
End If
End Function
Gruß Frank
Hallo
Probiers mal so
Private Function UmbruchRaus(ByVal MemoRein As String)
Dim Position As Integer
If Left$(MemoRein, 2) = vbCrLf Then MemoRein = Mid$(MemoRein, 3)
While InStr(MemoRein, vbCrLf & vbCrLf) <> 0 'Umbruch da
Position = InStr(MemoRein, vbCrLf & vbCrLf)
MemoRein = Left$(MemoRein, Position - 1) + Mid$(MemoRein, Position + 2)
Wend
UmbruchRaus = MemoRein
End Function
oder so
dim s as string
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)
Hallo! daolix
Danke ! Für die Hilfe klappt super die 2
Hab das so in ein externes Modul geschrieben
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
Aufruf
Private Sub Txt_AfterUpdate()
If Nz(Me!Txt, "") <> "" Then
Me!Txt = UmbruchRaus(Me!Txt)
End If
End Sub
Mit diesen aus Lesungen muss ich mich noch ein bisschen beschäftigen das habe ich noch nicht ganz verstanden mit den zahlen 2 3
Left$(MemoRein, 2) = vbCrLf Then MemoRein = Mid$(MemoRein, 3)
Gruß Frank
Hallo,
"noch nicht ganz verstanden mit den zahlen 2 3 "
schau dazu am Besten in die VBA-Hilfe zu den Funktionen Left() und Mid() ...
Hallo
Ich habe versucht das Ganze noch etwas aus zufielen komme da aber nicht ganz weiter wen der
Text mehr als 255 Zeichen hab wird er an dieser Stelle abgeschnitten da es ein ungebundenes fehl ist
Im 2. Schritt soll ermittelt werden ob der Text Zeilenumbrüche hat und diese zusammen geschoben werden und das ganze dann ab der 3. Zeile wen vorhanden gelöscht werden
Wär super wen mir da jemand helfen könnte Gruß Frank
Dim str As String
Dim int_str As Integer
Dim str_count As Integer
Dim Msg As String
If Len(Me!TxtBewerbungBetreff.Text) > 255 Then
Msg = " Der Text darf nur 255 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(Me!TxtBewerbungBetreff.Text, 255)
Me!TxtBewerbungBetreff.SelStart = 255
End If
str = Me!TxtBewerbungBetreff.Text
str = UmbruchRaus str
Do While Len(str) > 1
int_str = InStr(str, vbCrLf)
If int_str > 0 Then
str_count = str_count + 1
str = Right(str, (Len(str) - int_str))
If str_count > 2 Then
Msg = "Es dürfen für den betreff maximal 3 Zeilen verwendet werden"
MsgBox Msg, vbInformation Or vbOKOnly, "Nicht zulässig!"
hier fehlt noch alles ab der 3. Zeile löschen
Me!TxtBewerbungBetreff = str
End If
Else
str = ""
End If
Loop
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
probiers mal so
Dim str As String
Dim int_str As Integer
Dim str_count As Integer
Dim Msg As String
If Len(Me!TxtBewerbungBetreff.Text) > 255 Then
Msg = " Der Text darf nur 255 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(Me!TxtBewerbungBetreff.Text, 255)
Me!TxtBewerbungBetreff.SelStart = 255
End If
str = Me!TxtBewerbungBetreff.Text
str = UmbruchRaus(str)
if Len(str) > 0 then
dim sf() as string
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)
end if
Me!TxtBewerbungBetreff = Join(sf(), vbcrlf)
end if
Hallo,
mhmm, ich verstehe (mal wieder) nicht den Hintergrund der Geschichte....
Was haben 255 Zeichen Maximal-Länge mit 3 "Zeilen" zu tun?
Weshalb bleibt beim Löschen einer Zeile ein Leerzeile zurück.. Die ist doch auch löschbar...
Weshalb wird die TEXT-Eigenschaft des Steuerelementes benutzt?
Ein ungebundenes Steuerelement kann auch mehr als 255 Zeichen aufnehmen....
Hallo !
Danke für die Hilfe das funktioniert super
Hier 2 Bilder wie ich das Formular aufgebaut habe
(http://s7.directupload.net/images/120526/temp/summ8rnv.jpg) (http://s7.directupload.net/file/d/2902/summ8rnv_jpg.htm)
(http://s14.directupload.net/images/120526/temp/khmtww4n.jpg) (http://s14.directupload.net/file/d/2902/khmtww4n_jpg.htm)
Aus dem Unterformular schreibe ich mit dem Button die Daten für die Betreffzeile zur Erstellung eines Worddoc´s in das Feld betreff des Hauptformulars
Die Betreffzeile soll aber maximal 3 Zeilen haben da sonst der Standardtext in meinem Dokument auf die 2. Seite überlauft
Wenn man 3 Zeilen in das Feld schreibt und die mittlere löscht dann bleibt diese leer
Zeile 1
Leer
Zeile 3
Diese werden dann wie vorher im Beitrag erstellt zusammengeschoben
Damit sind es nur noch 2 Zeilen was bei erneutem einfügen aus dem Unterformular wieder 3 Zeilen ergibt
Das möchte ich im Afterupdate Ereignis den Textfelds korrigieren lassen falls im Feld von Hand manipuliert wird
Oder beim drücken des Buttons schon als Fehler gemeldet wird
Ich habe das Formular über ein Recordset gespeist und einfach mal versucht einen Text mit 5 Zeilen und über 255 Zeichen zu Speichern dann wurde mir der Fehler gemeldet
3163 Das Feld ist zu klein für die Datenmenge, die Sie hinzufügen wollten. Versuchen Sie, weniger Daten einzufügen.
Warum Recordset :
http://www.access-o-mania.de/forum/index.php?topic=15818.msg91416#msg91416 (http://www.access-o-mania.de/forum/index.php?topic=15818.msg91416#msg91416)
Gruß Frank
Hallo,
naja, wenn das Konzept dieser Brief-Erstellung so sein soll/muss....
Trotzdem versteh ich diese "Zeilen-Orientierung" nicht. In Word selber wird doch eine Textzeile, sobald sie länger als die akt. Zeilenbreite ist, automatisch umgebrochen.... Warum erledigst Du das auf Access.-Ebene? Ein "Betreff" besteht doch nicht in erster Linie aus einer Anzahl von (vorher) definierten Zeilen...
Aber wie gesagt, wenn es so sein soll...
Wenn der Betreff länger als 255 Zeichen (max. Tabellenfeld-Feldgröße) sein darf/kann, dann muss ein Memofeld herangezogen werden, wenn denn der Brief insgesamt als solcher auch in der DB als Datensatz gespeichert werden soll.
Die Fehlermeldung erscheint, wenn ein Text in ein gebundenes(!) Textfeld eingefügt werden soll, dessen zugehörendes Tabellenfeld eine dafür zu kleine Feldlänge (max. 255 Zeichen, außer Datentyp Memo) aufweist.
Hallo!
Ich möchte alle Daten für das Word anlegen in einer Tabelle das werde bis jetzt so 450 sein die aber nicht aus einer Tabelle stammen
Der betreff soll in dem fall nur für 3 Veranstaltungen gelten, bei denen ich ein Bewerbungsschreiben ausgeben möchte dienen
Das in Word die Zeile umgebrochen wird habe ich noch nicht mit Bedacht das sind in meinem Fall max.79 Zeichen jeweils pro Zeile
Mit Zeilenumbrüchen werden in einer Abfrage anstatt 237 ( L: Max(Länge([BewerbungBetreff])) ) 241 angezeigt damit würde die Feldgröße von 255 reichen
Über eine Button werden dann die Dokumente gefüllt in einen Ortner gespeichert und der Pfad in der Tabelle zum Datensatz gespeichert gelichzeitig wird nach vorherigem angeben im Datensatz das
Dokument entweder per Email als Pdf versendet oder an den Drucker weitergeleitet
Gruß Frank
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
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
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
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:
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
Sub BewerbungBetreffPrüfen()
Call TxtBewerbungBetreff_Change
End Sub
Im Testfeld selber:
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