AW: Worddatei öffnen
23.12.2015 10:59:00
Hajo_Zi
ich benutze folgenden Code.
Option Explicit ' Variablendefinition erforderlich
Option Private Module ' damit Makros nicht unter Makro erscheinen
Dim oWord_App As Object, oDoc As Object, bWordVorhanden As Boolean
' Autor Peter Haserodt
' http://www.online-excel.de/ _
excel/singsel_vba.php?f=41
Private Function Word_Connect() As Boolean
Word_Connect = True
On Error GoTo OpenError ' persönliche Fehlerbehandlung einschalten
' Gucken ob Word offen ist
Set oWord_App = GetObject(Class:="Word.Application")
' Veränderung Uwe Küstner aus folgendem Grund:
' Funktioniert sowohl bei Excel2003 als auch bei Excel97.
' Dort hat es nur zwei kleine Fehler:
' 1. Word wird nicht im Vollbildmodus geöffnet.
' 2. wenn Word in der Taskleiste sitzt, dann bleibt es auch dort,
' obwohl die Datei richtig geöffnet worden ist.
oWord_App.Activate
oWord_App.WindowState = 1
bWordVorhanden = True
On Error GoTo 0 ' Fehlerbehandlung einschalten
' Hier bei Bedarf prüfen ob Word sichtbar ist
Exit Function
OpenError: ' Word war nicht offen, also dann bitte öffnen
On Error GoTo CreateError ' persönliche Fehlerbehandlung einschalten
Set oWord_App = CreateObject(Class:="Word.Application")
' Dies gegebenenfalls rausnehmen wenn man unsichtbar arbeiten will
oWord_App.Visible = True
oWord_App.WindowState = 1 ' Veränderung Uwe Küstner
bWordVorhanden = False
Resume Next
Exit Function
CreateError:
' Word ist nicht vorhanden
MsgBox "Kein Word vorhanden"
Word_Connect = False
End Function
Private Sub Word_Disconnect()
' gegebenenfalls die Objektvariablen wieder freigeben
' Wir wollen ja keinen Verweis auf Word zurücklassen
On Error Resume Next
Set oDoc = Nothing
Set oWord_App = Nothing
End Sub
Public Sub TestOhneVerweis(StName As String)
If Not Word_Connect Then Exit Sub 'Raus wenns brennt
On Error GoTo Fehler
With oWord_App
' öffnen Ergänzung Hajo
If UCase(Right(StName, Len(StName) - InStrRev(StName, "."))) "DOT" _
Or UCase(Right(StName, Len(StName) - InStrRev(StName, "."))) = "DOTM" _
Or UCase(Right(StName, Len(StName) - InStrRev(StName, "."))) = "DOTX" Then
.Documents.Open StName
Else
.Documents.Add StName
End If
' Dieser Text wird in das Dokument geschrieben
'.Selection.Text = "He, dies funzt ja wirklich" & vbCrLf & vbCrLf & _
' "Jo is denn scho Weihnachten"
End With
Aufraeumen:
' Optionale Möglichkeit Word zu beenden, wenn wir es gestartet haben
'Hier muss man aber aufpassen, dass man vorher in Word aufgeräumt hat
' Also Dokumente geschlossen etc...
' If Not bWordVorhanden Then oWord_App.Quit
Word_Disconnect ' Nicht vergessen ;-) !!!!!!!!!!!!!!!!!!!!!! _
Exit Sub
Fehler:
MsgBox Err.Description
Resume Aufraeumen
End Sub
Sub test()
TestOhneVerweis (StOrdner & "\" & "Datei.doc")
End Sub