Excel nach Word
ing.grohn
meine Frage gehört eigentlich in ein Word-Forum. Weil ich das Ganze in Excel abwickle, hoffe ich, dass irgendwer hier eine Lösung weiß und stelle sie daher.
Mit den folgenden Zeilen lese ich Daten aus einer Excel Userform in eine Word-Dokumenten-Vorlage ein:
Sub BriefAn()
Dim frm1 As Object
Dim ObjWord As Object
Dim DocNeu As Object
Set frm1 = Uf_BriefAn
On Error Resume Next
Set ObjWord = GetObject("Word.Application")
If ObjWord Is Nothing Then
Set ObjWord = CreateObject("Word.Application")
ObjWord.Visible = True
End If
On Error GoTo 0
If Not ObjWord Is Nothing Then
Set DocNeu = ObjWord.Documents.Add(Template:= _
Workbooks("Code.xls").Sheets("Konstanten").Range("LW").Value _
& Workbooks("Code.xls").Sheets("Konstanten").Range("Vorlagen").Value _
& Workbooks("Code.xls").Sheets("Konstanten").Range("Briefan").Value)
End If
With DocNeu
.FormFields("Anrede").Result = frm1.TextBox20.Value
.FormFields("Vorname").Result = frm1.TextBox7.Value
.FormFields("Name").Result = frm1.TextBox6.Value
.FormFields("Strasse").Result = frm1.TextBox8.Value
.FormFields("PLZ").Result = frm1.TextBox9.Value
.FormFields("Ort").Result = frm1.TextBox10.Value
DocNeu.Application.Selection.MoveDown Unit:=wdLine, Count:=19
If Len(frm1.TextBox16.Value) > 0 Then
.Bookmarks("pAnrede").Range.text = frm1.TextBox16.Value
Else
.Bookmarks("pAnrede").Delete
' ObjWord.Selection.Delete Unit:=wdCharacter, Count:=1
End If
If Len(frm1.TextBox12.Value) > 0 Then
.Bookmarks("IhrZeichen").Range.text = frm1.TextBox12.Value
If Len(frm1.TextBox13.Value) > 0 Then
.Bookmarks("IhrDatum").Range.text = frm1.TextBox13.Value
Else
.Bookmarks("IhrDatum").Delete
End If
Else
.Bookmarks("IhrZeichen").Delete
.Bookmarks("IhrDatum").Delete
' ObjWord.Selection.EndKey Unit:=wdLine, Extend:=wdExtend
' ObjWord.Selection.Delete Unit:=wdCharacter, Count:=1
End If
If Len(frm1.TextBox17.Value) > 0 Then
.Bookmarks("Anliegen").Range.text = frm1.TextBox17.Value
Else
.Bookmarks("Anliegen").Delete
' ObjWord.Selection.Delete Unit:=wdCharacter, Count:=1
End If
If frm1.CheckBox1.Value = True Then
.Bookmarks("VornameM").Range.text = frm1.TextBox1.Value
.Bookmarks("NameM").Range.text = frm1.TextBox2.Value
If frm1.CheckBox2.Value = True Then
.Bookmarks("StrasseM").Range.text = frm1.TextBox3.Value
Else
.Bookmarks("StrasseM").Delete
End If
If frm1.CheckBox3.Value = True Then
.Bookmarks("PLZOrt").Range.text = frm1.TextBox4.Value & " " & frm1.TextBox5.Value
Else
.Bookmarks("PLZOrt").Delete
End If
Else
.Bookmarks("VornameM").Delete
.Bookmarks("NameM").Delete
.Bookmarks("StrasseM").Delete
.Bookmarks("PLZOrt").Delete
End If
If frm1.CheckBox4.Value = True Then
.Bookmarks("Rechtsschutz").Range.text = frm1.TextBox19.Value
.Bookmarks("Rechtsschutznr").Range.text = frm1.TextBox18.Value
.Bookmarks("SchadensNr").Range.text = frm1.TextBox26.Value
'ObjWord.Selection.MoveDown Unit:=wdLine, Count:=1
Else
.Bookmarks("Rechtsschutz").Delete
.Bookmarks("Rechtsschutznr").Delete
.Bookmarks("SchadensNr").Delete
ObjWord.Selection.Delete Unit:=wdCharacter, Count:=1
End If
If frm1.CheckBox5.Value = True Then
.Bookmarks("ProzReg").Range.text = frm1.TextBox14.Value
.Bookmarks("Beginn").Range.text = frm1.TextBox24.Value
Else
.Bookmarks("ProzReg").Delete
.Bookmarks("Beginn").Delete
End If
If frm1.CheckBox7.Value = True Then
.Bookmarks("Gegner").Range.text = frm1.TextBox25.Value
Else
.Bookmarks("Gegner").Delete
ObjWord.Selection.Delete Unit:=wdCharacter, Count:=1
End If
If frm1.CheckBox6.Value = True Then
.Bookmarks("Grund").Range.text = frm1.TextBox23.Value
Else
.Bookmarks("Grund").Delete
ObjWord.Selection.Delete Unit:=wdCharacter, Count:=1
End If
End With
DocNeu.Application.Activate
End Sub
Die Angaben für die Anschrift werden ohne Probleme übernommen.
Die folgenden Felder (Bookmarks) sind persönlicheAnrede, ihrDatum, ihrZeichen, Anliegen .. usw
Die Felder , ihrDatum, ihrZeichen, Anliegen waren leer. Im Ergebnis ist die persönliche Anrede um die Zeichen Seh gekürzt: r geehrte Frau Habers
Warum fehlen diese Zeichen?. Was muss im Code geändert werden?
Ich bedanke mich für eine Antwort
Mit freundlichen Grüßen
Albrecht