Hallo Leute,
ich habe mal wieder eine Frage. Hier zunächst der Codeausschnitt mit dem ich das vorher übe, was ich vor habe:
[...]
With worddoc
SetBookmark worddoc, "Angebotsnummer", Me!Angebotsnummer
SetBookmark worddoc, "Betreff", Me!Betreff
SetBookmark worddoc, "Datum", Me!Datum
Set rs = Me!uf_Angebotsposition.Form.RecordsetClone
If Not (rs.BOF And rs.EOF) Then
rs.MoveFirst
lngZeile = 2
While Not rs.EOF
With .Tables(2)
.Rows.Add
.Cell(lngZeile, 1).Range = Nz(rs!PositionsID, "")
.Cell(lngZeile, 2).Range = Nz(rs!Produktbezeichnung, "")
.Cell(lngZeile, 3).Range = Nz(rs!Menge, "")
rs.MoveNext
lngZeile = lngZeile + 1
End With
Wend
End If
rs.Close
Set rs = Nothing
End With
[...]
Wenn ich nun eine Zelle mit mehr als 50 Zeichen fülle, soll automatisch ein Zeilenumbruch in der Zelle erfolgen. Wie kann ich das darstellen? Oder kann die Tabelle in Word vorher so formatiert werden?
Vielen Dank schon einmal!
Hallo,
trage doch gleich die Formatierte Zeile ein:
Dim restzeichen AS long
Dim start As long
Dim i As long
.....
if len(Nz(rs!Produktbezeichnung, "") > 50 then
Restzeichen = len(Nz(rs!Produktbezeichnung, "") - 50
Do while Restzeichen > 0
.Cell(lngZeile+i, 2).Range = mid(Nz(rs!Produktbezeichnung, ""),start,50)
Restzeichen = Restzeichen - 50
start = start + 50
i = i + 1
Loop
else
.Cell(lngZeile, 2).Range = Nz(rs!Produktbezeichnung, "")
End if
lngZeile = lngZeile + i
Also so ungefär. müsste man noch genau testen mit dem mid() falls Restzeichen < 50
Gruß Andreas
Hallo,
dass eine gute Idee. Habe gerade noch etwas dran gefeielt, aber leider noch nicht, wie gewünscht.
Hier der Code der auch mit weniger als 50 Zeichen am Ende klarkommt:
Dim restzeichen As Long
Dim start As Long
Dim i As Long
i = 0
start = 1
If Len(Nz(rs!Produktbezeichnung, "") > 50) Then
restzeichen = Len(Nz(rs!Produktbezeichnung, "")) - 50
Do While restzeichen > 0
.Cell(lngZeile + i, 2).Range = Mid(Nz(rs!Produktbezeichnung, ""), start, 50)
restzeichen = restzeichen - 50
start = start + 50
i = i + 1
Loop
.Cell(lngZeile + i, 2).Range = Mid(Nz(rs!Produktbezeichnung, ""), start, 50)
Else
.Cell(lngZeile + i, 2).Range = Nz(rs!Produktbezeichnung, "")
End If
Es soll aber nach der ersten Befüllung quasi einmal die "Enter-Taste betätigt werden und nicht der restliche Test in eine neue unter gelegene Zelle.
Wie geht das? Wenn die Enter-Taste betätigt wird, vergrößert Word ja automatisch in der Zeile die Höhe und schreibt zweizeilig in die Zelle.
Bin nun weiter. Folgender Code ist aktuell und funktioniert:
Dim restzeichen As Long
Dim start As Long
'Dim i As Long
Dim test As String
'i = 0
start = 1
Dim zeichenzahl As Long
zeichenzahl = Len(Nz(rs!Produktbezeichnung, ""))
If zeichenzahl > 50 Then
restzeichen = Len(Nz(rs!Produktbezeichnung, "")) - 50
test = ""
Do While restzeichen > 0
.cell(lngZeile, 2).range = test & Mid(Nz(rs!Produktbezeichnung, ""), start, 50) '& Chr(11)
test = .cell(lngZeile, 2).range
restzeichen = restzeichen - 50
start = start + 50
'i = i + 1
Loop
test = .cell(lngZeile, 2).range
'MsgBox test
.cell(lngZeile, 2).range = test & Mid(Nz(rs!Produktbezeichnung, ""), start, 50)
Else
.cell(lngZeile, 2).range = Nz(rs!Produktbezeichnung, "")
End If
Kann man das noch schlanker erreichen?
Hallo,
in deinem Code fehlt die Lösung der Problematik dass mitten im Wort umgebrochen wird.
Dafür hab ich dir mal einen Code geschrieben:
Dim insertStr As String
Dim i As Long, k As Long, start As Long
Const maxLaenge As Long = 50
start = 1
Do While Len(testStr) - start > maxLaenge
insertStr = Mid(Nz(rs!Produktbezeichnung, ""), start, maxLaenge)
If Asc(Right(insertStr, 1)) <> 32 Then
Do While Asc(Mid(insertStr, maxLaenge - k, 1)) <> 32
k = k + 1
Loop
If k > 0 Then
insertStr = Left(insertStr, Len(insertStr) - k)
start = start - k
End If
End If
If Asc(Right(insertStr, 1)) = 32 Then
insertStr = Left(insertStr, Len(insertStr) - 1)
End If
.cell(lngZeile + i, 2).range = insertStr
start = start + maxLaenge
i = i + 1
k = 0
Loop
start = start - 1
If Len(Nz(rs!Produktbezeichnung, "")) - start > 0 Then
.cell(lngZeile + i, 2).range = Right(testStr, Len(Nz(rs!Produktbezeichnung, "")) - start)
End If
Gruß Andreas
Hallo Andreas,
er hat bei meinen Tests problemlos mitten im Wort umgeborchen.
Somit geht es damit z.Z.t problemlos.
Hallo,
und das passiert genau nicht mit meinem Code.
Aber wenn du mitten im Wort umbrechen möchtest, brauchst du ja nur meinen Code zu ändern um eine verkürzte Version zu haben:
Dim i As Long, start As Long
Const maxLaenge As Long = 50
start = 1
Do While Len(testStr) - start > maxLaenge
.cell(lngZeile + i, 2).range = Mid(Nz(rs!Produktbezeichnung, ""), start, maxLaenge)
start = start + maxLaenge
i = i + 1
Loop
start = start - 1
If Len(Nz(rs!Produktbezeichnung, "")) - start > 0 Then
.cell(lngZeile + i, 2).range = Right(Nz(rs!Produktbezeichnung, ""), Len(Nz(rs!Produktbezeichnung, "")) - start)
End If
In meinem vorherigen Code war noch ein Übertragungsfehler, am Schluss muss es heißen:
.cell(lngZeile + i, 2).range = Right(Nz(rs!Produktbezeichnung, ""), Len(Nz(rs!Produktbezeichnung, "")) - start)
Gruß Andreas