geöffnetes Worddokument aktivieren

Peter · 2019-10-31T05:29:08+00:00

Guten Morgen, ich öffne aus einer UF Word mit Workdokument. Wie kann ich nach dem Öffnen dieses Dokument anzeigen - also von Excel auf Word wechseln? Besten Dank für eure Hilfe. Gruss Peter

Hallo Karl-Heinz,
anbei der gesamte Code:
Option Explicit
Dim blnTMP As Boolean 'benötigt für <pre>Private Function OffApp(ByVal strApp As String, Optional blnVisible As Boolean = True) As Object
'Funktion zur Prüfung ob Worddatei geöffnet - benötigt in: CommandButton4_Click und CommandButton12_Click
<pre>Private Function OffApp(ByVal strApp As String, _
Optional blnVisible As Boolean = True) As Object
Dim objApp As Object
On Error Resume Next
Set objApp = GetObject(, strApp & ".Application")
Select Case Err.Number
Case 429
Err.Clear
Set objApp = CreateObject(strApp & ".Application")
blnTMP = True
If blnVisible = True Then
On Error Resume Next
objApp.Visible = True
objApp.WindowState = 1 '0 = Normal; 1 = Maximized; 2 = Minimized
Err.Clear
End If
End Select
On Error GoTo 0
Set OffApp = objApp
Set objApp = Nothing
End Function</pre>
'Word öffnen
<pre>Private Sub CommandButton1_Click()
Dim objDocument As Object
Dim strDatei As String
Dim strPath As String
Dim strTeilPath As String
Dim objApp As Object
Dim strDName As String
' Wenn ein Fehler auftritt gehe zu der angegebenen Sprungmarke
On Error GoTo Fin 'wird benötigt, da sonst Fehlermeldung angezeigt wird
' Pfad anpassen - fester Pfad vorgeben
'strPath = "C:\Temp\Word\"
' Pfad anpassen - Worddateien sind im gleichen
' Verzeichnis wie DIESE Exceldatei
'' strPath = ThisWorkbook.Path & Application.PathSeparator 'dadurch keine Pfadangabe in Tabelle erforderlich z.B. Zelle B9
'' strTeilPath = Worksheets("Worddaten").Range("B12") & Application.PathSeparator
'' If Me.ListBox2.Value = "" Then
'' Me.Label7.Font.Size = 12
'' Me.Label7.Caption = vbLf & " bitte Worddatei auswählen!"
'' Exit Sub
'' Else
'' strDName = Me.ListBox2.Value
'' End If
Set objApp = OffApp("Word")
' Word nicht sichtbar
'Set objApp = OffApp("Word", False)
If Not objApp Is Nothing Then
'' strDatei = Dir$(strPath & strTeilPath & strDName, vbDirectory) 'nimmt den gewählten Worddatei-Namen noch wenn leer einbauen
' Worddokument öffnen
'' Set objDocument = objApp.Documents.Open _
'' (strPath & strTeilPath & strDatei)
Set objDocument = objApp.Documents.Open _
("C:\Users\Peter\Desktop\Wordtest\Dok1_mit_eingebauter_Beenden_Funktion.docm")
'' objDocument = objApp.Documents.Open _
'' (strPath & strTeilPath & strDatei)
objDocument = objApp.Documents.Open _
("C:\Users\Peter\Desktop\Wordtest\Dok1_mit_eingebauter_Beenden_Funktion.docm")
End If
Fin: 'benötigt für Vermeidung von Fehlermeldung
' Worddokument ohne speichern schlissen
' objDocument.Close False
''' Worddokument mit speichern schlissen
''''' objDocument.Close True
'''''
'''''
''''' If objApp.Documents.Count = 0 Then
''''' objApp.Quit
''''' End If
'''''
''''' ' Objektvariablen leeren
''''' Set objDocument = Nothing
''''' Set objApp = Nothing
' 'Information in Label7 löschen
' Me.Label7.Caption = "gewählte Worddatei geöffnet!"
'
'
' CommandButton13.Enabled = False
' CommandButton12.Enabled = True
' ListBox2.Enabled = False
' CommandButton4.Enabled = False
''' Dim AppWD As Object, objWordDoc As Object
''' Dim objWordRange As Object
''' Set AppWD = CreateObject("Word.Application")
''' AppWD.Visible = True
'''' Set objWordDoc = AppWD.Documents.Open("D:\Temp\xxx.docx")
''' Set objWordDoc = AppWD.Documents.Open("C:\Users\Peter\Desktop\Wordtest\Dok1_mit_eingebauter_Beenden_Funktion.docm")
'''
''''' With objWordDoc.ActiveWindow.Selection
''''' .WholeStory
''''' .ConvertToTable Separator:=1, NumColumns:=3, NumRows:=48, AutoFitBehavior:=0
''''' End With
'''
'''''Set AppWD = Nothing
'''Set Wd = Nothing
End Sub</pre>
'Word schliessen
<pre>Private Sub CommandButton2_Click()
Dim objDocument As Object
Dim strDatei As String
Dim strPath As String
Dim strTeilPath As String
Dim objApp As Object
Dim strDName As String
' Wenn ein Fehler auftritt gehe zu der angegebenen Sprungmarke
On Error GoTo Fin 'wird benötigt, da sonst Fehlermeldung angezeigt wird
' Pfad anpassen - fester Pfad vorgeben
'strPath = "C:\Temp\Word\"
' Pfad anpassen - Worddateien sind im gleichen
' Verzeichnis wie DIESE Exceldatei
'' strPath = ThisWorkbook.Path & Application.PathSeparator 'Pfad +"\" = & Applictaion.PathSeperator
'' If Me.ListBox2.Value = "" Then
'' Me.Label7.Font.Size = 12
'' Me.Label7.Caption = vbLf & " bitte Worddatei auswählen!"
'' Exit Sub
'' Else
'' strDName = Me.ListBox2.Value
'' End If
Set objApp = OffApp("Word")
' Word nicht sichtbar
'Set objApp = OffApp("Word", False)
If Not objApp Is Nothing Then
'' strTeilPath = Worksheets("Worddaten").Range("B12") & "\"
''
'' strDatei = Dir$(strPath & strTeilPath & strDName, vbDirectory)
' Worddokument öffnen
'' Set objDocument = objApp.Documents.Open _
'' (strPath & strTeilPath & strDatei)
Set objDocument = objApp.Documents.Open _
("C:\Users\Peter\Desktop\Wordtest\Dok1_mit_eingebauter_Beenden_Funktion.docm")
End If
Fin: 'benötigt für Vermeidung von Fehlermeldung
'Wenn Word nicht geöffnet ist Abbruch
If objApp Is Nothing Then
Exit Sub
Else
'Worddokument ohne speichern schliessen
'objDocument.Close False
'Worddokument mit speichern schliessen
objDocument.Close True
If objApp.Documents.Count = 0 Then
objApp.Quit
End If
End If
' Objektvariablen leeren
Set objDocument = Nothing
Set objApp = Nothing
mmandButton13.Enabled = False
End Sub</pre>
'Beenden
<pre>Private Sub CommandButton3_Click()
Unload Me
End Sub</pre>
'gehe zu Word
<pre>Private Sub CommandButton4_Click()
Call test
End Sub</pre>
'gehe zu Word gesamt
<pre>Private Sub CommandButton5_Click()
CommandButton1 = True
CommandButton4 = True
End Sub</pre>
Gruss
Peter

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=&GT;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

geöffnetes Worddokument aktivieren

Forumthread: geöffnetes Worddokument aktivieren

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Infobox / Tutorial

Word-Dokument aus Excel aktivieren

Schritt-für-Schritt-Anleitung

Häufige Fehler und Lösungen

Alternative Methoden

Praktische Beispiele

Tipps für Profis

FAQ: Häufige Fragen

Beliebteste Forumthreads (12 Monate)

geöffnetes Worddokument aktivieren

Forumthread: geöffnetes Worddokument aktivieren

13 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Infobox / Tutorial

Word-Dokument aus Excel aktivieren

Schritt-für-Schritt-Anleitung

Häufige Fehler und Lösungen

Alternative Methoden

Praktische Beispiele

Tipps für Profis

FAQ: Häufige Fragen

Beliebteste Forumthreads (12 Monate)

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread