Anzeige
Archiv - Navigation
1372to1376
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA: Texte und Tabellen nach Word übernehmen

VBA: Texte und Tabellen nach Word übernehmen
28.07.2014 09:57:36
Dani
Moin,
Ich habe eine Tabelle, aus der ich Texte aus definierten Zellen sowie eine wechselnde Anzahl von Tabellen unterschiedlicher Größe, die ich nach Word übertragen möchte. Allerdings habe ich 2 Probleme:
1. Ich übernehme die Texte bisher mit folgendem Codeschnipsel:
strFileName = ThisWorkbook.Path & "\" & "Vorlage_Angebot_Englisch_Draft.doc"
If Dir(strFileName) "" Then
Application.ScreenUpdating = False
Set objWDApp = GetObject(, "Word.Application")
If objWDApp Is Nothing Then Set objWDApp = CreateObject("Word.Application")
End If
Set objDoc = objWDApp.Documents.Add(strFileName)
Worksheets(2).Activate
Range("C2").Copy
objWDApp.ActiveDocument.Bookmarks("Kundennummer").Range.Pasteandformat (wdpasteText)

Hierbei wird allerdings immer die ursprüngliche Textformatierung aus Word überschrieben. Gibt es eine Option (PasteSpecial TextOnly), die die ursprüngliche Formatierung beibehält? Oder muss ich das Format später in Word wieder neu ändern?
2.
Ich übernehme die Tabellen immer als Bild mit folgendem Code:
Range("A1:F" & letztezeile).Copy
objWDApp.ActiveDocument.Bookmarks("Blatt1").Range.Pasteandformat (wdChartPicture)

Die Textmarken in Word habe ich alle auf eine Seite gesetzt, weil meine Tabellen immer unterschiedlich groß sind und leider auch verschieden lang sind. Gibt es eine Option, dass eine Tabelle immer auf eine Seite gequetscht wird und vor jeder Tabelle eine neue Seite angefangen wird?
Danke schon einmal im Voraus für die Hilfe!
Dani

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA: Texte und Tabellen nach Word übernehmen
28.07.2014 12:39:09
fcs
Hallo Dani,
zu 1. Excelinhalte ohne Formate einfügen
probiere es mal mit einer anderen Einfügeoption:
objWDApp.ActiveDocument.Bookmarks("Kundennummer").Range.Pasteandformat (wdFormatPlainText) ' (wdpasteText)
Alternativ könntes du versuchen den Inhalt der Excelzelle dierekt der Range der Textmarke zuweisen.
objWDApp.ActiveDocument.Bookmarks("Kundennummer").Range.Text = Range("C2").Text

zu 2. Grafiken der Excel-Tabellenbereiche.
Word setzt ja automatisch Seitenwechsel, wenn der Platzt für eine Grafik nick nicht reicht. Wenn diese Automatik nicht reicht, dann muss du entweder durch Absatzformatierungen oder manuelle Seitenwechsel im Musterdokument dafür sorgen, dass Seitenwechsel an den gewünschten Positionen erfolgen.
Grundsätzlich kann man die Größe der Grafiken anpassen, wenn diese zu hoch sind. Es ist aber nicht so ganz einfach, die eingefügten Grafiken zu greifen.
Erfolgt das Einfügen hintereineinander in Richtung Dokumentend und sind Richtung Dokumentende keine weiteren Grafiken (InlineShapes) vorhanden, dann könnte folgendes funktionieren.
Gruß
Franz
Sub aatest()
On Error Resume Next
strFileName = ThisWorkbook.Path & "\" & "Vorlage_Angebot_Englisch_Draft.doc"
If Dir(strFileName)  "" Then
Application.ScreenUpdating = False
Set objWDApp = GetObject(, "Word.Application")
If objWDApp Is Nothing Then
Set objWDApp = CreateObject("Word.Application")
End If
objWDApp.Visible = True
Set objDoc = objWDApp.Documents.Add(strFileName)
Worksheets(2).Activate
Range("C2").Copy
objWDApp.ActiveDocument.Bookmarks("Kundennummer").Range.Pasteandformat (22) '22= _
wdFormatPlainText
'günstigere Alternative für das formatlose Einfügen von Zell-Text an Word-Textmarke.
objWDApp.ActiveDocument.Bookmarks("Kundennummer").Range.Text = Range("C2").Text
letztezeile = 15
Range("A1:F" & letztezeile).Copy
objDoc.Bookmarks("Bild1").Range.Pasteandformat (wdChartPicture)
Call prcInlineShapeHoehe(objDoc.InlineShapes(objDoc.InlineShapes.Count), 600)
letztezeile = 70
Range("A1:F" & letztezeile).Copy
objDoc.Bookmarks("Bild2").Range.Pasteandformat (wdChartPicture)
Call prcInlineShapeHoehe(objDoc.InlineShapes(objDoc.InlineShapes.Count), 600)
End If
End Sub
Private Sub prcInlineShapeHoehe(wdshape As Object, dblHoehe As Double)
'Reduziert die Höhe eines Word-InlineShapes ggf. auf den vorgegebenen Wert
With wdshape
If .Height > dblHoehe Then
.LockAspectRatio = True
.Height = dblHoehe
End If
End With
End Sub

Anzeige

299 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige