Option Explicit

Dim WrdApp As Word.Application

Const Pfad = "C:\"

Sub Word_steuern()

'Voraussetzung:

'Extras/Verweise/Microsoft Word 11.0 Object Library

On Error GoTo Fehler

Range("A1") = InputBox _

("Geben Sie bitte einen beliebigen Text ein.", _

"Eingabe in A1", "Hallo Fans!")

Set WrdApp = New Word.Application

'Dokument demodoku.doc öffnen

WrdApp.Documents.Open Pfad & "demodoku.doc"

'Word sichtbar machen(überflüssig)

WrdApp.Visible = True

'Inhalt des geöffneten Dokuments

'wird vollständig gelöscht

WrdApp.ActiveDocument.Content.Delete

'In die aktuelle Auswahl in Word

With WrdApp.Selection

'wird der Text geschrieben

.TypeParagraph 'neuer Absatz

.Font.Bold = True 'ab jetzt fett

.TypeText Text:="Hier ist das Worddokument "

.Font.Bold = False 'fett ausschalten

.Font.Italic = True 'ab jetzt kursiv

.TypeText Text:="demodoku.doc"

.Font.Italic = False 'kursiv ausschalten

.TypeParagraph

.TypeText _

Text:="...und das ist der Inhalt von A1: "

.TypeParagraph

.Font.Bold = True

.TypeText Text:=vbTab & vbTab _

& vbTab & vbTab & vbTab & Range("A1")

.Font.Bold = False

.TypeParagraph

.TypeParagraph

.TypeText _

Text:="In 5 Sekunden geht es zurück zu Excel - BITTE WARTEN!"

.TypeParagraph

End With

'Zur Demonstration wird 5 Sekunden gewartet

Application.Wait _

TimeSerial(Hour(Now()), Minute(Now()), Second(Now()) + 5)

'Dokument speichern

WrdApp.ActiveDocument.SaveAs Pfad & "demodoku.doc"

WrdApp.Quit 'Die Applikation beenden

Set WrdApp = Nothing 'Variable leeren

Exit Sub

Fehler:

MsgBox _

"Fehler Nr.: " & Err.Number & vbCrLf & Err.Description

WrdApp.Quit

Set WrdApp = Nothing

End Sub