AW: Excel Export nach Word - Zellbereich
22.09.2007 01:46:22
fcs
Hallo Michael,
ich bin fündig geworden und hab das Ganze noch um ein paar Varianten erweitert.
Möglich sind folgende Einfügungen eines Excel-Tabellenbereichs an einer Textmarke in einem Worddokument:
1 als RTF (in Word wird eine Tabelle kreiert, die viele Formata aus Excel enthält)
2 als Text getrennt durch Tabs
3 als Excel-Objekt ohne Verknüpfung
4 als BitMap Grafik (es gibt noch ein paar andere Grafikvarianten!)
5 Zellenweise Texteigenschaft in eine Leertabelle im Worddokument
In der ZIP-Datei findest du das Word-Muster, das Ergebnis nach dem Tranfer und die Excel-Datei mit den Beispspieldaten und dem Makro.
Beschreibungen zu Details der Funktion findest du in der VBA-Prozedur als Kommentar.
https://www.herber.de/bbs/user/46255.zip
MfG
Franz
Option Explicit
'###### fcs, aktualisiert 2007-09-21 ######
'Zur korrkten Funktion der Prozedur muss im Excel-VBA-Editor unter Extras-->Verweise _
der Verweis auf die "Microsoft Word x.y Object Library" als verfügbar markiert werden.
'Prozedur wurde erstellt unter Office97 (Word97/Excel97)
'MS Word muss geöffnet sein bevor die Prozedur gestarte wird
Sub Daten_aus_Bereich_nach_Word()
'Fügt Daten aus Excel an Textmarke in ein Worddokument ein
'Deklaration Word-Objekte
Dim wdDoc As Word.Document, TextMarke As Word.Bookmark, TabZeile As Word.Row
'Deklaration Excel-Objekte
Dim wks As Worksheet, Bereich As Range
'Deklaration allgemeine Variablen
Dim strWordDatei As String
Dim iI As Long, lngZeile As Long, FehlerNr As Integer
On Error GoTo Fehler
Application.ScreenUpdating = False
Set wks = ActiveWorkbook.Worksheets("Tabelle1") 'Tabelle mit zu exportierenden Daten
Application.ActivateMicrosoftApp xlMicrosoftWord
FehlerNr = 1
'Worddokument in das eingefügt werden soll
strWordDatei = "C:\Eigene Dateien\Dokumente\TextausgabeMuster.doc"
'Prüfung ob Word-Dokument schon geöffnet
For Each wdDoc In Word.Documents
If LCase(Word.ActiveDocument.FullName) = LCase(strWordDatei) Then
If MsgBox("Das Musterdokument ist schon geöffnet!" & vbLf & vbLf & _
"Trotzden weitermachen?", vbQuestion + vbOKCancel, "Datentransfer nach Word") _
= vbCancel Then
GoTo weiter01
Else
Exit For
End If
End If
Next
If wdDoc Is Nothing Then
Set wdDoc = Word.Documents.Open(FileName:=strWordDatei, ReadOnly:=True)
Else
wdDoc.Activate
End If
'Exceldaten übertragen und im Worddokument an einer Textmarke einfügen
With wdDoc
'Daten kopieren und 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 kopieren und 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 kopieren und 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 kopieren und 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
Application.CutCopyMode = 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 muss in der Linken _
Zelle dieser Leerzeile gesetzt werden. Word-Tabelle und Excel-Bereich müssen _
die gleiche Spaltenzahl haben! Wenn nicht, dann müssen die For-Next-Schleifen _
anders aufgebaut werden.
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 & _
"Die Textmarke muss in einer Tabelle plaziert sein in der letzten Zeile."
End If
For lngZeile = 1 To Bereich.Rows.Count
For iI = 1 To TabZeile.Cells.Count
TabZeile.Cells(iI).Range.InsertAfter Text:=Bereich.Cells(lngZeile, iI).Text
Next iI
If lngZeile 0 Then Word.Application.WindowState = wdWindowStateMinimize
MsgBox "Word- oder Excel-Fehler Nr. " & Err.Number & " ist aufgetreten!" & vbLf & vbLf _
& Err.Description
Beenden:
Application.ScreenUpdating = True
Set wdDoc = Nothing: Set TextMarke = Nothing: Set TabZeile = Nothing
Set wks = Nothing: Set Bereich = Nothing
End Sub