mehrere Word Documente einbinden

Hallo Ihr Excel Freaks,
ich suche jetzt schon einige Zeit herum, aber ich kann keine Lösung zu meinem Problem finden.
Ich habe ein Excel Dokument, in das ich verschiedene Word Dokumente einbinden möchte.
Die Word-Dateinamen stehen in den Zellen von A1 bis A15. Die Word Dokumente können unterschiedlich lang sein, sie sollen aber hintereinander in mein Excel Arbeitsblatt ab der Zelle A20 eingefügt werden.
Ich finde keine Lösung dafür. Mir fehlt die Idee, wie ich ermitteln kann, welches die nächste freie Zelle nach dem jeweils eingefügten Word Dokument ist.
In diesem Zusammenhang habe ich noch ein zweites wahrscheinlich kleineres Problem. In meine Tabelle muss ich noch eine Grafik aus einem Exceldokument (TDS.... xls einfügen. Der genaue Dateiname des TDS-Exceldokumentes steht in A16. Da die TDS Blätter von verschiedenen Lieferanten erstellt werden, hat die Grafik unterschiedliche Bezeichnungen. Es befindet sich aber immer nur eine Grafik auf jedem TDS-Blatt.
Wie kann ich diese Grafik hinter meine eingefügten Word-dokumente anhängen?
Vielen Dank schon mal im voraus.
Fettertiger

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Fettertiger,
vom Ablauf her ist es einfacher die Worddateien als Objekte zu laden, wobei prinzipiell die Vorgehensweise gleich ist.
Nachfolgend Makros für beide Probleme. Du kannst die beiden Makros auch zu einem zusammenfassen. dann entfällt die Schleife mit der Suche nach dem am weitesten unten eingefügten Shape-Objekt. Achte dann darauf, dass im zusammengefassten Makro alle Variablen-Deklarationen enthalten sind.
Gruß
Franz


Sub DateienEinbinden()
' Dateien als Objekte einbinden
Dim oleDatei As OLEObject, wks As Worksheet, Zelle As Range, I%, Abstand%
Dim strFileName$, wb As Workbook, Figur As Shape
Set wks = ActiveSheet
Abstand = 1 'Leere Tabellenzeilen zwischen zwei Dokumenten
Set Zelle = wks.Cells(20, 1) 'Startzelle für Worddateien
For I% = 1 To 15 'Dateienamen inklusive Pfad stehen in Zeilen 1 bis 15 der Spalte 1 (A)
strFileName = wks.Cells(I, 1).Value
If strFileName  "" Then
If Dir(strFileName)  "" Then
Set oleDatei = wks.OLEObjects.Add(FileName:=strFileName, Link:=False, _
DisplayAsIcon:=False)
oleDatei.Top = Zelle.Top
oleDatei.Left = Zelle.Left + 2
Set Zelle = wks.Cells(oleDatei.BottomRightCell.Row + Abstand + 1, 1)
Else
MsgBox "Folgende Datei nicht gefunden: " & strFileName
End If
End If
Next
Zelle.Select
End Sub
Sub GradikAusExcelDateiEinbinden()
'Grafik aus Ecxeldatei einbinden
Dim wks As Worksheet, Zelle As Range, I%, Abstand%
Dim strFileName$, wb As Workbook, Figur As Shape, wbAktiv As Workbook
Set wbAktiv = ActiveWorkbook
Set wks = ActiveSheet
Abstand = 1 'Leere Tabellenzeilen zwischen zwei Dokumenten
strFileName = wks.Cells(16, 1).Value 'TDS-Dateiname inklusive Pfadangabe
'Unterste Abbildung / Shape-Objekt ermitteln
For Each Figur In wks.Shapes
I% = Application.WorksheetFunction.Max(I%, Figur.BottomRightCell.Row)
Next
Set Zelle = wks.Cells(I% + Abstand + 1, 1)
If strFileName  "" Then
If Dir(strFileName)  "" Then
Set wb = Workbooks.Open(FileName:=strFileName, ReadOnly:=True)
Set Figur = wb.Worksheets(1).Shapes(1)
Figur.Copy
wbAktiv.Activate
wks.Paste
Set Figur = wks.Shapes(wks.Shapes.Count)
Figur.Top = Zelle.Top
Figur.Left = Zelle.Left + 2
wb.Close savechanges:=False
Set Zelle = wks.Cells(Figur.BottomRightCell.Row + Abstand + 1, 1)
Else
MsgBox "Folgende Datei nicht gefunden: " & strFileName
End If
End If
Zelle.Select
End Sub

Beliebteste Forumthreads (12 Monate)

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread