AW: Tabelle in Word-Dokument einfügen
27.08.2009 01:12:50
fcs
Hallo Dieter,
hier ein Beispiel-Makro für verschiedene Einfüge-Varianten.
Gruß
Franz
Option Explicit
'HINWEIS: Unter Extras-Verweise muss der Verweis auf die Microsoft Word x.y Objekt Library _
aktiviert werden.
Sub DatenBereich_nach_Word_uebertragen()
'Fügt Daten aus Excel an Textmarke im aktiven Worddokument ein
Dim doc As Word.Document, TextMarke As Word.Bookmark, TabZeile As Word.Row
Dim strWordDatei As String
Dim wks As Worksheet, Zelle As Range, I As Long, Zeile As Long, strText As String
Dim Bereich As Range, Zaehler As Long
Set wks = ActiveWorkbook.Worksheets("Tabelle1") 'Tabelle mit zu exportierenden Daten
Application.ActivateMicrosoftApp xlMicrosoftWord
'Worddokument in das eingefügt werden soll
strWordDatei = "C:\Users\Public\Test\TextausgabeMuster.doc"
'Prüfung ob Dokument schon geöffnet
For Each doc In Word.Documents
If LCase(Word.ActiveDocument.FullName) = LCase(strWordDatei) Then
Exit For
End If
Next
If doc Is Nothing Then
Set doc = Word.Documents.Open(FileName:=strWordDatei, ReadOnly:=True)
Else
doc.Activate
End If
'Exceldaten übertragen und im Worddokument an einer Textmarke einfügen
With doc
'Daten in Worddokument einfügen im RTF-Format
'es wird eine Wordtabelle erzeugt, die einen Teil der Formatierungen aus der _
Exceldatei übernimmt
Set Bereich = wks.Range("A3:E6") 'Bereich mit den zu exportierenden Daten
Bereich.Copy
Set TextMarke = .Bookmarks("Excel1_RTF")
TextMarke.Range.PasteSpecial Link:=False, DataType:=wdPasteRTF, _
Placement:=wdInLine, DisplayAsIcon:=False
'Daten in Worddokument einfügen als Text
'Wenn die Zeile mit der Textmarke Tabulatoren enthält, dann werden die _
die Daten aus den Excelspalten entsprechend dargestellt
Set Bereich = wks.Range("A4:E6") 'Bereich mit den zu exportierenden Daten
Bereich.Copy
Set TextMarke = .Bookmarks("Excel2_TXT")
TextMarke.Range.PasteSpecial Link:=False, DataType:=wdPasteText, _
Placement:=wdInLine, DisplayAsIcon:=False
'Daten in Worddokument einfügen als Excel-Objekt ohne Verknüpfung
Set Bereich = wks.Range("A3:E6") 'Bereich mit den zu exportierenden Daten
Bereich.Copy
Set TextMarke = .Bookmarks("Excel3_Objekt")
TextMarke.Range.PasteSpecial Link:=False, DataType:=wdPasteOLEObject, _
Placement:=wdInLine, DisplayAsIcon:=False
'Daten in Worddokument einfügen als Bitmapgrafik-Grafik ohne Verknüpfung
Set Bereich = wks.Range("A3:E6") 'Bereich mit den zu exportierenden Daten
Bereich.Copy
Set TextMarke = .Bookmarks("Excel4_Grafik")
TextMarke.Range.PasteSpecial Link:=False, DataType:=wdPasteBitmap, Placement:= _
wdInLine, DisplayAsIcon:=False
'Daten in Worddokument einfügen in vorbereitete Word-Tabelle
'Dokument enthält eine Tabelle deren letzte Zeile leer ist und das Muster _
für die einzufügenden Daten darstellt. Diese letzte Zeile wird entsprechend _
der Anzahl Zeilen im Bereich dupliziert. Die Textmarke ist in der Linken Zelle _
dieser Leerzeile gesetzt.
Set Bereich = wks.Range("A4:E6") 'Bereich mit den zu exportierenden Daten
Set TextMarke = .Bookmarks("Excel5_Tabelle")
If TextMarke.Range.Information(wdWithInTable) = True Then
Set TabZeile = TextMarke.Range.Rows(1)
Else
MsgBox "Textmarke ist im Worddokument nicht korrekt positioniert!" & vbLf & _
End If
For Zeile = 1 To Bereich.Rows.Count
For I = 1 To TabZeile.Cells.Count
TabZeile.Cells(I).Range.InsertAfter Text:=Bereich.Cells(Zeile, I).Text
Zaehler = Zaehler + 1
Next I
If Zeile