PDA

Vollständige Version anzeigen : Zellen unformatiert nach Word kopieren und dort formatieren


bennnil
01.09.2019, 16:05
Hallo zusammen,
ich habe eine Excel Tabelle aus der ich alle Felder einer Spalte neben denen sich ein "x" in einer Zelle befindet in ein Word Dokument unformatiert kopieren möchte. Das einfache Einfügen bekomme ich jetzt schon mit dem nachfolgenden Programmcode hin. Allerdings möchte ich den Text nun an eine bestimmte Stelle im Dokument platzieren, und die einzelnen Zellen sollen als Aufzählung mit Bulletpoints angefügt werden.
Bisher habe ich über die Anzahl der Sätze die Position bestimmt und danach eingefügt - das funktioniert - die Aufzählung funktioniert so allerdings nicht. Habt ihr einen Tipp für mich wie ich die Einfügestelle mit einer Textmarke oder ähnlichem realisiert bekomme ? Im Excel Forum hat man mir den Hinweis gegeben, dass ihr mir hier vielleicht weiterhelfen könnt ;-)


Dim objWord As Word.Application
Dim objDoc As Word.Document
Dim Transportvariable As Variant
Set objWord = New Word.Application
Set objDoc = objWord.Documents.Open("E:Template.docx")
Dim inputRange As Range
Dim Range2 As Range
Set inputRange = Range("F8:F400")


Dim myUnion As Range
Dim myCell As Range

For Each myCell In inputRange
If myCell.Value Like "x" Then
If Not myUnion Is Nothing Then
Set myUnion = Union(myUnion, myCell.Offset(0, -1))
Else
Set myUnion = myCell.Offset(0, -1)
End If
End If
Next myCell

myUnion.Select
Selection.Copy
ActiveSheet.Paste Destination:=Worksheets("Temp").Range("A1")
newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 1
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime

Worksheets("Temp").Columns("A").Copy
objDoc.Content.Sentences(10).PasteSpecial Link:=False, DataType:=wdPasteText, Placement:= _
wdInLine, DisplayAsIcon:=False


objWord.Visible = True

Dim sourceSheet As Worksheet
Set sourceSheet = Temp
sourceSheet.Columns("A").EntireColumn.Delete

Application.CutCopyMode = False
Set objWord = Nothing
Set objDoc = Nothing

End Sub