ich kämpfe momentan mit folgendem Problem:
Ich habe eine Excel Datei aus der ich vorher gefilterte Tabellen in Word kopieren möchte).
Das klappt soweit auch recht gut (ich verwende offene Textmarken um mich im Word Dokument an die richtigen stellen zu bewegen).
Es kann aber vorkommen das ich hinter eine Textmarke mehr als eine Tabelle kopieren muss.
Wenn ich das versuche wird in die erste Zelle der Tabelle, die ich vorher ins Word Dic. kopiert habe, die neue Tabelle eingefügt.
Wie kann ich meinen Code so umbauen das die Textmarke immer hinter die zuletzt erstellte Tabelle kopiert wird?
Das Word Dokument ist wie so aufgebaut:
Überschrift 1
[Textmarke: Text1]
Überschrift 2
[Textmarke: Text2]
Überschrift 3
[Textmarke: Text3]
Code:
Dim objWord As Word.Application
Dim WrdFile As Word.Document
Dim bWordOffen As Boolean ' Wenn Word schon offen war dann "true", wenn es durch das Macro gestartet wurde dann "false"
Dim WrdRange As Word.Range
' Versuchen eine laufende Instanz von Wort zu verwenden
On Error Resume Next
Set objWord = GetObject(, "Word.Application")
bWordOffen = True
' Wenn Word nicht ausgeführt wird, Word starten
On Error GoTo errorMsgWord
If objWord Is Nothing Then
bWordOffen = False
Set objWord = CreateObject("Word.Application")
End If
' Dokument öffnen
On Error GoTo errorMsgVorlage
Set WrdFile = objWord.Documents.Add(Template:=sWrdTemplateName, NewTemplate:=False)
WrdFile.SaveAs sWrdReport
'#######################################################################################################
'##### Word Datei nun offen, Platz für Code hier rein ##################################################
On Error Resume Next
Rows("1:1").AutoFilter
Rows("1:1").AutoFilter Field:=6, Criteria1:="=Test1*", Operator:=xlAnd
ActiveSheet.UsedRange.Copy
WrdFile.Bookmarks("Text1").Range.PasteExcelTable False, False, False
' -> Geht
Rows("1:1").AutoFilter Field:=6, Criteria1:="=Test2*", Operator:=xlAnd
ActiveSheet.UsedRange.Copy
WrdFile.Bookmarks("Text2").Range.PasteExcelTable False, False, False
' -> Geht
Rows("1:1").AutoFilter Field:=6, Criteria1:="=Test3*", Operator:=xlAnd
ActiveSheet.UsedRange.Copy
WrdFile.Bookmarks("Text3").Range.PasteExcelTable False, False, False
' -> Geht
Rows("1:1").AutoFilter Field:=6, Criteria1:="=Test4*", Operator:=xlAnd
ActiveSheet.UsedRange.Copy
WrdFile.Bookmarks("Text1").Range.PasteExcelTable False, False, False
' -> Geht NICHT, Text landet in Spalte der Tabelle die bereits nach Textmarke 1 geschrieben wurde...
Rows("1:1").AutoFilter 'autofilter Aus
'#######################################################################################################
'##### Die Datei soll geschlossen werden... ############################################################
'
GoTo ClearExit
ClearExit:
' Word beenden, falls wir es erst gestartet haben
WrdFile.Save
WrdFile.Close
If bWordOffen = False Then
objWord.Application.Quit
End If
Set WrdFile = Nothing
Set objWord = Nothing
Exit Sub
errorMsgWord:
Debug.Print "Es konnte keine Verbindung zu Word hergestellt werden!", 16, "Fehler"
Exit Sub
errorMsgVorlage:
Debug.Print "Die Dokumentvorlage '" & sWrdTemplateName & " konnte nicht geöffnet werden !", 16, "Fehler"
GoTo ClearExit