Ach ja, was mir bei den beiden neuen Varianten aufgefallen ist - ich erhalte (glaube nicht immer, aber manchmal) die Meldung
"Mein Beispiel.docx ist zur Bearbeitung gesperrt. Möchten Sie:
-Schreibgeschützte Kopie öffnen
-Lokale Kopie erstellen und Änderungen später zusammenführen
-Benachrichtigen, wenn das Original zur Verfügung steht"
Könnte aber gut sein, dass das mit dem mitten drin abbrechen des Markos zu tun hat, weil dann ja noch eine Word-Instanz offen ist.
Moin!
Wenn er bis dahin kommt, ist es ja schonmal gut. Dann müsste man halt nur noch das Copy umschreiben.
Ich habe mir nochmal den Code vom AltenDresdner bzw. schauan angeschaut. Das mit der einen Seite kann ich bestätigen. Das "Problem" ist, dass die Mappe in WordDoc die ganzen goto Befehle bekommt und nicht die Mappe Erg. Deswegen war auch das activate nötig. Das lässt sich jetzt schneller beheben als mein Code. Ändere den Elseteil der Schleife mal so um:
Code:
Else 'anfügen
On Error Resume Next
Kill "temp.docx"
On Error GoTo 0
WordDoc.SaveAs ThisWorkbook.Path & "\temp.docx"
WordDoc.Close False
With Wordobj
.Selection.Goto What:=3, Which:=1, Count:=1
.Selection.InsertBreak Type:=7
.Selection.Goto What:=3, Which:=1, Count:=1
.Selection.InsertFile Filename:=ThisWorkbook.Path & "\temp.docx", Range:="", _
ConfirmConversions:=False, Link:=False, Attachment:=False
End With
Write #1, "eingefügt " & j
end if
Jetzt wird WordDoc nach dem Speichern geschlossen. Damit liegt nur noch Erg vor und das fängt dann die goto Befehle auf. HAbe eben mal getestet. Damit kommen auch drei Seiten. Vllt. schaue ich mal noch, ob ich mein copy umstelle. Das hier sollte aber auch funktionieren.
Moin!
Ich nochmal. ALso habe mal das Kopieren und Löschen über das Object rseite rausgenommen. Der Code ist jetzt so (komplett). Kannst ja mal testen, ob das unter 365 läuft.
Code:
Option Explicit
Option Base 1
Dim Wordobj As Object, WordDoc As Object, WordErg As Object
Dim Marken(), anzMark As Long, anzFall As Long
Sub WordAusfüllen()
Dim wasopen As Boolean, MyName As String, Fenster, rseite, tempr, rende
Dim j As Long, k As Long
On Error Resume Next
Kill ThisWorkbook.Path & "\" & "ablauf.txt"
Open ThisWorkbook.Path & "\" & "ablauf.txt" For Output As #1
Set Wordobj = GetObject(, "Word.Application")
wasopen = (Err.Number = 0)
If Err.Number <> 0 Then 'Word nicht offen
Set Wordobj = CreateObject("Word.Application")
'Wordobj.Visible = True
Else 'ggfls. offene Dateien schließen
For Each Fenster In Wordobj.documents
If Fenster.Name = "erg.docx" Or Fenster.Name = "temp.docx" Or Fenster.Name = ActiveSheet.Range("A1") Then Fenster.Close False
Next Fenster
End If
Err.Clear ' Err-Objekt im Fehlerfall löschen.
On Error GoTo 0
Write #1, "Word offen"
anzFall = 3 'Anzahl der Varianten lesen
Do
If IsEmpty(Cells(anzFall + 1, 1)) Then Exit Do
anzFall = anzFall + 1
Loop
anzFall = anzFall - 2
Write #1, "Varianten: " & anzFall
ReDim Marken(1) 'Textmarkennamen lesen
anzMark = 1
Do
If anzMark > UBound(Marken) Then ReDim Preserve Marken(anzMark)
Marken(anzMark) = Cells(2, anzMark)
Write #1, "Textmarke: " & Marken(anzMark)
If IsEmpty(Cells(2, anzMark + 1)) Then Exit Do
anzMark = anzMark + 1
Loop
Set WordDoc = Wordobj.documents.Open(ThisWorkbook.Path & "\" & ActiveSheet.Range("A1"))
MyName = WordDoc.Name
Write #1, j & ": " & WordDoc.Name
Set rseite = Wordobj.Selection.Goto(What:=1, Which:=1, Count:=1)
Wordobj.Selection.Goto What:=1, Which:=1, Count:=2
rseite.End = Wordobj.Selection.Bookmarks("\Page").Range.End
rende = Wordobj.Selection.Bookmarks("\Page").Range.End
'For j = anzFall + 1 To 3 Step -1
For j = 3 To anzFall + 1
For k = 1 To anzMark
If WordDoc.Bookmarks.Exists(Marken(k)) Then Set tempr = WordDoc.Bookmarks(Marken(k)).Range
WordDoc.Bookmarks(Marken(k)).Delete
tempr.Text = Cells(j, k) & " - " & Cells(anzFall + 2, k)
If Not WordDoc.Bookmarks.Exists(Marken(k)) Then WordDoc.Bookmarks.Add Name:=Marken(k), Range:=tempr
Abgesehen davon, dass sich im PDF nach jeder Zeile aus Excel immer eine unnötige Leerseite befindet, passt es jetzt, vielen Dank nochmal an alle für die Hilfe!
Ich werde jetzt erstmal etwas Zeit brauchen, um den zu versuchen, den Code zu verstehen, damit ich ihn auf meine Tabellen anpassen/erweitern kann. Gut möglich, dass dabei wieder Fragen auftreten, aber erstmal danke bis dahin, ich melde mich dann in jedem Fall nochmal.
Moin!
Schön das es klappt. Bzgl. der Leerseite schaue mal, ob sich das Ergebnis ändert, wenn du die Zeile hier rausnimmst
Code:
Wordobj.Selection.InsertBreak Type:=7
Die fügt extra einen Zeilenumbruch ein. Kann sein, dass den Ex365 von Haus aus schon macht. Dann wäre der doppelt und würde dein Ergebnis erklären. Ansonsten müsstest du vermtl. mit der leeren Seite leben.
VG
Folgende(r) 1 Nutzer sagt Danke an Gast für diesen Beitrag:1 Nutzer sagt Danke an Gast für diesen Beitrag 28 • MartinaS
wie man an der Uhrzeit sehen kann, war ich sehr fleißig
Das Verstehen und Erweitern hat einiges an Zeit gekostet, aber es funktioniert nun überwiegend schon so, wie es soll. Drei Fragen habe ich allerdings noch:
1. Da sich die Word-Vorlagen wie beschrieben immer wieder ändern wollte ich gerne die Marken Gruppieren, um diese leichter in eine neue Vorlage kopieren zu können - aus irgendeinem Grund fehlt dann jedoch der erste Datensatz. Ich kann mir zwar auch leicht angewöhnen, bei den Vorlagen die Gruppierung immer wieder aufzuheben (ist wahrscheinlich eh einfacher), aber ich verstehe nicht, wie das sein kann...?
2. Wenn die Word-Vorlage mehr als eine Seite hat, also die Marken über mehr als eine Seite verteilt sind, funktioniert es nicht. Klar, denn er kopiert ja auch immer nur eine Seite. Aber wie könnte ich das ändern?
3. Kleine Frage am Rande: Mit welchem Befehl kann ich am Ende die letzte Seite des Word-Dokuments vor dem Speichern löschen?
Moin!
Hut ab - bis um 3 noch programmieren.
Hier mal mein Beitrag zu deinem Problem.
1. Da weiß ich ehrlich nicht, wie du das genau meinst. Ggf. in einer Beispiel docx mal hochladen, dann kann man da testen (auch wenn es sich ggf. am 365 mal ändert).
2. Mit welchem Code arbeitest du? Den ggf. mal posten. Bei meinem Code sollte er eigentlich beide Seiten kopieren. Bei dem Ursprungscode wird aber immer das Dokument am Ende eingefügt. Wenn das 2 Seiten hat, kommen 2 dazu, wenn mehr oder weniger, dann dementsprechend. Das kann ich nicht nachvollziehen, warum er nur eine Seite einfügt.
3.Die letzte Seite löschen kannst du nur über die Range. Hier mal ein Beispiel für deinen Code. Den vor dem Speichern von WordErg als pdf einfügen. Dabei wird die Range der vorletten Seiten gesucht, dann die der letzten und der Bereich dazwischen dann gelöscht. Mittels Objekten könnte man es ggf. auch kürzer machen. Da letzten aber das Objekt nicht richtig funktionierte, habe ich den Code ausführlicher gemacht. Schaue mal, ob er von der vorletzten Seite nicht auch was löscht. Habe beim Delete ein -1 drin, da sonst bei mir noch ein Absatz da war und die letzte Seite zwar geleert aber noch da war.
Moin!
ICh vermute, du hast den Wert noch in der Zwischenablage. Die müsstest du löschen. Das würde mit cutcopymode gehen. Bei dir dann vor dem Schließen wohl so
Code:
ordObj.cutcopymode = false
Bei mir wollte er das aber machen. Alternativ könntest du es auch so machen
Code:
Dim oData As DataObject
Set oData = New DataObject
oData.SetText ""
oData.PutInClipboard
Dabei sollte ein Verweis auf die Microsoft Forms 2.0 Object Library gesetzt sein. Falls es da Dataobject so nicht erstellen kann (hatte ich eine Weile) kannst du es auch über latebinding erstellen. In meinem Excel geht das so:
Code:
Set oData = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
![[-]](https://www.clever-excel-forum.de/images/collapse.png)
