Hi tester,
die Grundidee war Word zu starten mit leerem Blatt, alle
eingebetteten Wordobjekte zu öffnen, sie im hauptdokument
„anzuhängen“ und dann zu schliessen.
Ich kriege das aber nicht hin, da ich mich in Word nicht
auskenne.
Zumindest ist jetzt das problem verlagert, jetzt stellt sich
die Frag, wie erstelle ich aus vielen geöffneten
Worddokumenten ein Worddokument.
Vielleicht hilft dir mein Code ein bisschen weiter.
Hallo,
ja, der Code hilft mir sehr weiter. Ich hatte nämlich überhaupt keine Ahnung, wie man OLE-Objekt in Excel-VBA anspricht und an den Inhalt drankommt. Vielen Dank für den Musterprogrammcode.
Habe die Prozedur nach meine Zwecken angepasst.
Hier ist sie:
Sub meineVersion()
Dim Blatt As Worksheet
Dim n As Long
Dim WdApp As Object
Dim WdSammelDok As Object
Dim OLEDok As Object
Dim erstesDok As Boolean
'Word öffnen und Dokument erstellen
Set WdApp = GetObject("", "Word.Application")
If WdApp Is Nothing Then Set WdApp = CreateObject("Word.Application")
'Gesamtdokument erzeugen
Set WdSammelDok = WdApp.Documents.Add(Visible:=True)
erstesDok = True
'Objekte auslesen
For Each Blatt In ThisWorkbook.Worksheets
With Blatt
For n = 1 To Blatt.OLEObjects.Count
If Not erstesDok Then WdSammelDok.Range(WdSammelDok.Content.End - 1).InsertBreak (7)
erstesDok = False
.OLEObjects(n).Verb Verb:=xlOpen
Set OLEDok = .OLEObjects(n).Object.Application.ActiveDocument
OLEDok.Content.Copy
WdSammelDok.Range(WdSammelDok.Content.End - 1).Paste
OLEDok.Close False
Next n
End With
Next Blatt
'Dokument einrichten, speichern und Ende
With WdSammelDok.PageSetup
.TopMargin = WdApp.CentimetersToPoints(0.63)
.BottomMargin = WdApp.CentimetersToPoints(0.63)
.LeftMargin = WdApp.CentimetersToPoints(2.5)
.RightMargin = WdApp.CentimetersToPoints(2.5)
End With
WdSammelDok.SaveAs "C:\test\komplett.doc"
WdApp.Visible = True
Set WdApp = Nothing
Set WdSammelDok = Nothing
Set OLEDok = Nothing
End Sub
Vielen Dank für die Mühe und nette Grüße, tester
