AW: Excel-Export nach Word
06.06.2020 22:24:22
fcs
Hallo Maria,
hier ein entsprechendes Excel-Makro.
zur Info hab ich auch als Mommentare die entsprechenden Codes mit den Word-VBA-Variablen eingeügt.
LG
Franz
Sub prcKopieren_Excel_nach_Word()
'kopiert den benutzten Zellbereich eines Excel-Tabellenblatts in eine Worddatei
Dim wdAPP As Object 'Word.Application
Dim wdDoc As Object 'Word.Document
Dim wkb As Workbook, wks As Worksheet
Set wkb = ActiveWorkbook
Set wks = wkb.Worksheets(1)
On Error GoTo Fehler
'geöffnetes Word benutzen oder Word starten
Set wdAPP = VBA.GetObject(, "Word.Application")
If wdAPP Is Nothing Then
'Wordstarten
Set wdAPP = VBA.CreateObject("Word.Application")
End If
wdAPP.Visible = True
'Worddatei schreibgeschützt öffnen
Set wdDoc = wdAPP.Documents.Open(Filename:=wkb.Path & "\wordtest.doc", _
ReadOnly:=True, Format:=0)
'alle Inhalte im Word-Hauptdokument löschen
'wdDoc.StoryRanges(wdMainTextStory).Delete Unit:=wdCharacter, Count:=1
wdDoc.StoryRanges(1).Delete Unit:=1, Count:=1
'Bereich im Tabellenblatt kopieren
With wks
.UsedRange.Copy
End With
'Code zum Einfügen in Word mit Word-VBA-Variablen
'Exceldaten als Text im Unicode-Format einfügen
' wdDoc.StoryRanges(wdMainTextStory).PasteSpecial Link:=False, _
DataType:=22, Placement:=wdInLine, _
DisplayAsIcon:=False
'Exceldaten als Text einfügen
' wdDoc.StoryRanges(wdMainTextStory).PasteSpecial Link:=False, _
DataType:=wdPasteText, Placement:=wdInLine, DisplayAsIcon:=False
'Exceldaten 'im RTF-Format einfügen
' wdDoc.StoryRanges(wdMainTextStory).PasteExcelTable False, False, True
'Code für Excel - Word-VBA-Variablen sind durch nummerische Werte ersetzt
'Exceldaten als Text im Unicode-Format einfügen
wdDoc.StoryRanges(1).PasteSpecial Link:=False, DataType:=22, _
Placement:=0, DisplayAsIcon:=False
'Exceldaten als Text einfügen
' wdDoc.StoryRanges(1).PasteSpecial Link:=False, DataType:=2, _
Placement:=0, DisplayAsIcon:=False
'Exceldaten 'im RTF-Format einfügen
' wdDoc.StoryRanges(1).PasteExcelTable False, False, True
Application.CutCopyMode = False
wdAPP.Activate
Fehler:
With Err
Select Case .Number
Case 0 'alles OK
Case 429 'Objekt-Fehler - Word ist noch nicht geöffnet
If wdAPP Is Nothing Then
'Word starten
Set wdAPP = VBA.CreateObject("Word.Application")
End If
Resume Next
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description, _
vbOKOnly, "Makro: prcKopieren_Excel_nach_Word"
End Select
End With
End Sub