Microsoft Excel

Herbers Excel/VBA-Archiv

VBA: Texte und Tabellen nach Word übernehmen

Betrifft: VBA: Texte und Tabellen nach Word übernehmen von: Dani
Geschrieben am: 28.07.2014 09:57:36

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

  

Betrifft: AW: VBA: Texte und Tabellen nach Word übernehmen von: fcs
Geschrieben am: 28.07.2014 12:39:09

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



 

Beiträge aus den Excel-Beispielen zum Thema "VBA: Texte und Tabellen nach Word übernehmen"