Hallo ! Unten nochmal dein Code. Was für ein Fehler tritt den auf? Konnte es nicht nachstellen. In dem Sub DocProperties überehmen, kopierst du aus einer Zelle. Dabei werden an den Text immer noch 2 Zeichen angefügt (ZIelenumbruch und noch was glaube cih wolhl chr 10 und 13). Die am besten vor de zuweisen löschen. Also 2 Zeichen am Ende wegnehmen. VG
Private Sub DocProperties_kopieren_Click()
Dim wrdApp As Object
Dim wrdDoc As Object
Dim i As Integer
'Create word document
Set wrdApp = CreateObject("Word.Application")
wrdApp.Visible = True
Set wrdDoc = wrdApp.Documents.Add
'Fill word document
Call FillWordDoc(wrdDoc)
'Save document
FullName = Application.ActiveDocument.Path & "\" & "Document Properties.rtf"
With wrdDoc
If Dir(FullName) <> "" Then
Kill FullName
End If
.SaveAs FileName:=FullName, FileFormat:=wdFormatRTF
'.Close
' close the document
End With
End Sub
Sub FillWordDoc(Doc As Object)
Doc.Content.InsertParagraphAfter
'Create header table
Doc.Content.InsertParagraphAfter
Doc.Content.InsertParagraphAfter
pos = Doc.Content.End
Doc.Tables.Add Range:=Doc.Range(pos - 1, pos - 1), numrows:=23, numcolumns:=2, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=wdAutoFitContent
'Fill header table
Doc.Tables.Item(1).Cell(1, 1).Range.Text = "test"
Doc.Tables.Item(1).Cell(1, 2).Range.Text = ActiveDocument.CustomDocumentProperties("test").Value
Doc.Tables.Item(1).Cell(2, 1).Range.Text = "ende"
Doc.Tables.Item(1).Cell(2, 2).Range.Text = ActiveDocument.CustomDocumentProperties("ende").Value
End Sub
Private Sub DocProperties_importieren_Click()
With ActiveDocument
Dim Doc As Object
Doc = Application.ActiveDocument.Path & "\" & "Document Properties.rtf"
.CustomDocumentProperties("test").Value = Doc.Tables.Item(1).Cell(1, 2).Range.Text
.CustomDocumentProperties("ende").Value = Doc.Tables.Item(1).Cell(2, 2).Range.Text
End With
End Sub
|