AW: Test in anderer Weise gelungen...
01.11.2019 11:00:30
volti
Hallo Peter,
ich habe Dir mal Deinen doch recht undurchsichtigen code etwas umgeschrieben und hoffe, dass es so gedacht ist.
Der u.a. code öffnet und schließt das angegebene Dokument mittels Button1 und Button2. Mit Button3 kann man es auch zwischendurch aufrufen. Button4 beendet die Form.
Probiere es einfch mal aus. Den ganzen auskommentierten Text habe ich weggelassen....
Option Explicit
'Funktion zur Prüfung ob Worddatei geöffnet - benötigt in: CommandButton4_Click und CommandButton12_Click
Private Function OffApp(Optional ByVal strApp As String = "Word", Optional blnVisible As Boolean = True) As Object
On Error Resume Next
Set OffApp = GetObject(, strApp & ".Application") 'Word schon offen?
If Err.Number = 429 Then
Err.Clear
Set OffApp = CreateObject(strApp & ".Application") 'Word öffnen
End If
If Not OffApp Is Nothing Then
OffApp.Visible = blnVisible
OffApp.WindowState = 1 '0 = Normal; 1 = Maximized; 2 = Minimized
OffApp.Activate
End If
End Function
'Word öffnen
Private Sub CommandButton1_Click()
Dim objDocument As Object, objApp As Object
Dim strDatei As String, strPath As String
strPath = "D:\Telekomwelt\TEX-Dashboard\"
strDatei = "TEX-Dashboard-Anleitung.docx"
' Wenn ein Fehler auftritt gehe zu der angegebenen Sprungmarke
On Error GoTo Fehler
Set objApp = OffApp("Word") 'Wordhandle bzw. Object holen
If Not objApp Is Nothing Then
Set objDocument = objApp.documents.Open(strPath & strDatei)
If objDocument Is Nothing Then
MsgBox "Das Dokument '" & strDatei & "' konnte nicht geöffnet werden!", vbOKOnly Or vbExclamation, "Worddokument öffnen""
End If
End If
Exit Sub
Fehler:
MsgBox "Es ist ein Fehler aufgetreten!", vbOKOnly Or vbExclamation, "Worddokument öffnen"
End Sub
'Word schliessen
Private Sub CommandButton2_Click()
'Alle Worddokumente durchgehen und eine oder alle Dokumente schließen
Dim objDocument As Object, objApp As Object, strDatei As String
strDatei = "*" 'Hier ggf. Dateinamen einer Datei angeben
' Wenn ein Fehler auftritt gehe zu der angegebenen Sprungmarke
On Error GoTo Fehler
Set objApp = GetObject(, "Word.Application")
If Not objApp Is Nothing Then
For Each objDocument In objApp.documents
If objDocument.Name Like strDatei Or strDatei = "*" Then
' objDocument.Close False 'Worddokument ohne speichern schliessen
objDocument.Close True 'Worddokument mit speichern schliessen
End If
Next
If objApp.documents.Count = 0 Then objApp.Quit 'Wenn kein Dokument mehr auf ist=>Word schließen
End If
' Objektvariablen leeren
Set objDocument = Nothing
Set objApp = Nothing
Fehler:
End Sub
'Frm Beenden
Private Sub CommandButton3_Click()
Unload Me
End Sub
'Gehe zu Word
Private Sub CommandButton4_Click()
Call OffApp
End Sub
viele Grüße
Karl-Heinz