Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1852to1856
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Problem beim Öffnen Worddokument aus Exc
06.11.2021 13:02:54
Peter
Hallo,
ich habe folgendes Problem:
Ich arbeite auf meinem Rechner mit Office 2013 und auf einem anderen mit Office 2016.
Mit den nachstehenden Makros öffne ich eine Wordvorlage nach zuvor ausgewählten Datenschritten, das Worddokument öffnet sich.
Beim Schliessen des Worddokument, wird dieses schreibgeschützt ohne Makros abgespeichert.
Über eine Listbox kann das Worddokument ausgewählt und geöffnet werden. Es werden dann die gespeicherten Werte angezeigt.
Dieses Dokument ist bewusst schreibgeschützt. Es kann dann über einen Button im Formular geschlossen werden.
Dieses funktioniert bei mir auf dem Rechner einwandfrei. Wenn ich das gleiche auf dem anderen Rechner ausführe, wird ein nicht mit
Werten gespeichertes Dokument geöffnet - es sucht die Makros im Worddokument. Da dieses Dokument nicht ordnungsgemäss gespeichert ist,
wird das Makro beim Öffnen von Worddokument in der Zeile "wrdDoc.SelectContentControlsByTag("Pflichtfeld").Item(1).Range = PflichtName" aus dem
Code von Button "Private Sub CommandButton18_Click" angehalten mit Laufzeitfehler '6124' Sie sind nicht berechtigt, diese Auswahl zu bearbeiten, weil
es geschützt ist.

Option Explicit
Private WrdApp As Object, wrdDoc As Object
Private strDName As String, strPfad As String, strName As String
'gewählte Worddatei öffnen
Private Sub CommandButton14_Click()
Dim pfad As String
Dim PflichtName As String  'neu für Pflichtfeld
'Anfang - Pfad für Wordvorlage und strName für Dateiname der WORD-Vorlage aus Listbox2
pfad = ThisWorkbook.Path & "\"    'von Gerhard 2021_04_23
'Debug.Print Pfad
strDName = pfad & ListBox2.Value
'Debug.Print strDName
'Ende - Pfad für Wordvorlage und strName für Dateiname der WORD-Vorlage aus Listbox2
PflichtName = Worksheets("Worddaten").Range("A2").Value
'Debug.Print PflichtName
Set WrdApp = CreateObject("Word.Application")
'    WrdApp.Visible = True   'True = sichtbar
WrdApp.Visible = False   'False = nicht sichtbar    'dadurch wird erst das aktualisierte Dokument1 angezeigt
WrdApp.WindowState = 1  '1 = maximal
WrdApp.Application.DisplayAlerts = 0
Set wrdDoc = WrdApp.Documents.Add(strDName)
WrdApp.Run "pfadAktualisieren"
'        wrdDoc.SelectContentControlsByTag("Pflichtfeld").Item(1).Range = "Test"
'        wrdDoc.SelectContentControlsByTag("Pflichtfeld").Item(1).Range = "Carl-von-Linde-Gymnasium"
wrdDoc.SelectContentControlsByTag("Pflichtfeld").Item(1).Range = PflichtName
WrdApp.Visible = True   'True = sichtbar    'dadurch wird erst das aktualisierte Dokument1 angezeigt
With Label45
.BackColor = &H8000000F
.Caption = "Dokument1 aus Vorlage" & vbLf & strDName & vbLf & "wurde geöffnet!"
End With
CommandButton14.Enabled = False
CommandButton15.Enabled = True
CommandButton2.Enabled = False
wrdDoc.Activate     'dadurch wird geöffnetes Dokument sofort sichtbar
End Sub
'gewählte Worddatei schliessen
Private Sub CommandButton15_Click()
Dim ZielPfad As String
Dim DatName As String
Dim wdFormatDocument
Dim strDokNeu As String
Dim strDokNeu2 As String
Dim Eingabe As String
Dim PflichtName As String  'neu für Pflichtfeld
ZielPfad = ThisWorkbook.Path & "\"    'von Gerhard 2021_04_23
PflichtName = Worksheets("Worddaten").Range("A2").Value
'Debug.Print PflichtName
'Anfang - Dokumentennahme entsprechend Schuljahr bzw. Kalenderjahr
If Worksheets("Hilfstabelle").Range("C3") > "" Then 'Kalenderjahr
DatName = Left(ListBox2, Len(ListBox2) - 5) & "_" & Right(TextBox1, 4) & "_" & Date
'Debug.Print DatName
'Debug.Print ZielPfad & DatName
wrdDoc.Activate     'dadurch wird das zu speichernde Dokument1 ausgewählt
strDokNeu = ZielPfad & DatName & ".docx"
'Debug.Print strDokNeu
ElseIf Worksheets("Hilfstabelle").Range("C2") > "" Then 'Schuljahr
DatName = Left(ListBox2, Len(ListBox2) - 5) & "_" & Right(TextBox1, 4) & "_" & Right(TextBox2, 4) & "_" & Date
'Debug.Print DatName
'Debug.Print ZielPfad & DatName
wrdDoc.Activate     'dadurch wird das zu speichernde Dokument1 ausgewählt
strDokNeu = ZielPfad & DatName & ".docx"
'Debug.Print strDokNeu
End If
'Ende - Dokumentennahme entsprechend Schuljahr bzw. Kalenderjahr
With wrdDoc
'            .SelectContentControlsByTag("Pflichtfeld").Item(1).Range = "Test1"
.SelectContentControlsByTag("Pflichtfeld").Item(1).Range = PflichtName
If Dir(strDokNeu) = "" Then           'wenn kein Dokument vorhanden ist
'schreibgeschützt   'damit wird Dokument1 unter vorgegebenem Namen schreibgeschützt gespeichert
WrdApp.ActiveDocument.SaveAs Filename:=ZielPfad & DatName & ".docx", FileFormat:= _
wdFormatDocument, LockComments:=False, Password:="", AddToRecentFiles:= _
True, WritePassword:="", ReadOnlyRecommended:=True, EmbedTrueTypeFonts:= _
False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
SaveAsAOCELetter:=False
'MsgBox "Das Dokument wurde im Ordner: " & strDokNeu & " schreibgeschützt - gespeichert!"
Label39.Font.Size = 12
Label39.Caption = "Das Dokument wurde im Ordner: " & strDokNeu & " schreibgeschützt - gespeichert!"
'Anfang WordDoc schliesen und ggf. Word beenden
If Not WrdApp Is Nothing Then
wrdDoc.Close 0
If WrdApp.Documents.Count = 0 Then WrdApp.Quit
Set wrdDoc = Nothing
Set WrdApp = Nothing
End If
With Label39
.BackColor = &HC0FFC0
.Caption = "Die Datei " & """" & strDName & """" & " wurde geschlossen!"
End With
CommandButton14.Enabled = False
CommandButton15.Enabled = False
'Ende WordDoc schliesen und ggf. Word beenden
'Anfang - zu erledigende Aufgaben
'da Dokument1 unter neuem Namen in Ordner "Dokumente" gespeichert wird, muss u.a. Makro ausgeführt werden
Call Word_Vorlagen_Laufend_auflisten
Call ListBox3_aktualisieren
CommandButton13 = True
ListBox2.Enabled = True
CommandButton8 = True   'Auswahl löschen
Label31.Caption = "Die Datei " & """" & (Worksheets("Worddaten").Range("B24")) & """" & " wurde geschlossen!"
Label39.Caption = vbLf & vbLf & "  Bitte neue Auswahl treffen oder mittels Button ""Beenden"" das Formular schliessen!"
'Ende - zu erledigende Aufgaben
Else
If MsgBox("Wollen Sie das Dokument mit neuem Namen speichern?", vbOKCancel, "Meldung1") = vbOK Then
Do
Eingabe = InputBox("Bitte den Namenzusatz eingeben")
If StrPtr(Eingabe) = 0 Then
'Anfang WordDoc schliesen und ggf. Word beenden
If Not WrdApp Is Nothing Then
wrdDoc.Close 0
If WrdApp.Documents.Count = 0 Then WrdApp.Quit
On Error GoTo 0
Set wrdDoc = Nothing
Set WrdApp = Nothing
End If
With Label39
.BackColor = &HC0FFC0
.Caption = "Die Datei " & """" & strDName & """" & " wurde geschlossen!"
End With
CommandButton14.Enabled = False
CommandButton15.Enabled = False
'Ende WordDoc schliesen und ggf. Word beenden
'Anfang - zu erledigende Aufgaben
'da Dokument1 unter neuem Namen in Ordner "Dokumente" gespeichert wird, muss u.a. Makro ausgeführt werden
Call Word_Vorlagen_Laufend_auflisten
Call ListBox3_aktualisieren
CommandButton13 = True
ListBox2.Enabled = True
CommandButton8 = True   'Auswahl löschen
Label31.Caption = "Die Datei " & """" & (Worksheets("Worddaten").Range("B24")) & """" & " wurde geschlossen!"
Label39.Caption = vbLf & vbLf & "  Bitte neue Auswahl treffen oder mittels Button ""Beenden"" das Formular schliessen!"
'Ende - zu erledigende Aufgaben
Exit Sub
End If
Loop While Eingabe = vbNullString
strDokNeu2 = ZielPfad & DatName & Eingabe & ".docx"
'Debug.Print strDokNeu2
'Anfang nochmalige Prüfung für strFile2
If Dir(strDokNeu2) = "" Then           'wenn kein Dokument vorhanden ist
'schreibgeschützt   'damit wird Dokument1 unter vorgegebenem Namen schreibgeschützt gespeichert
WrdApp.ActiveDocument.SaveAs Filename:=ZielPfad & DatName & Eingabe & ".docx", FileFormat:= _
wdFormatDocument, LockComments:=False, Password:="", AddToRecentFiles:= _
True, WritePassword:="", ReadOnlyRecommended:=True, EmbedTrueTypeFonts:= _
False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
SaveAsAOCELetter:=False
Label39.Font.Size = 12
Label39.Caption = "Das Dokument wurde im Ordner: " & strDokNeu2 & " schreibgeschützt - gespeichert!"
'Anfang WordDoc schliesen und ggf. Word beenden
If Not WrdApp Is Nothing Then
wrdDoc.Close 0
If WrdApp.Documents.Count = 0 Then WrdApp.Quit
Set wrdDoc = Nothing
Set WrdApp = Nothing
End If
With Label39
.BackColor = &HC0FFC0
.Caption = "Die Datei " & """" & strDName & """" & " wurde geschlossen!"
End With
CommandButton14.Enabled = False
CommandButton15.Enabled = False
'Ende WordDoc schliesen und ggf. Word beenden
'Anfang - zu erledigende Aufgaben
'da Dokument1 unter neuem Namen in Ordner "Dokumente" gespeichert wird, muss u.a. Makro ausgeführt werden
Call Word_Vorlagen_Laufend_auflisten
Call ListBox3_aktualisieren
CommandButton13 = True
ListBox2.Enabled = True
CommandButton8 = True   'Auswahl löschen
Label31.Caption = "Die Datei " & """" & (Worksheets("Worddaten").Range("B24")) & """" & " wurde geschlossen!"
Label39.Caption = vbLf & vbLf & "  Bitte neue Auswahl treffen oder mittels Button ""Beenden"" das Formular schliessen!"
'Ende - zu erledigende Aufgaben
Else
Do
Eingabe = InputBox("Bitte anderen Namenzusatz eingeben - da bereits vorhanden")
If StrPtr(Eingabe) = 0 Then
'Anfang WordDoc schliesen und ggf. Word beenden
If Not WrdApp Is Nothing Then
wrdDoc.Close 0
If WrdApp.Documents.Count = 0 Then WrdApp.Quit
Set wrdDoc = Nothing
Set WrdApp = Nothing
End If
With Label39
.BackColor = &HC0FFC0
.Caption = "Die Datei " & """" & strDName & """" & " wurde geschlossen!"
End With
CommandButton14.Enabled = False
CommandButton15.Enabled = False
'Ende WordDoc schliesen und ggf. Word beenden
'Anfang - zu erledigende Aufgaben
'da Dokument1 unter neuem Namen in Ordner "Dokumente" gespeichert wird, muss u.a. Makro ausgeführt werden
Call Word_Vorlagen_Laufend_auflisten
Call ListBox3_aktualisieren
CommandButton13 = True
ListBox2.Enabled = True
CommandButton8 = True   'Auswahl löschen
Label31.Caption = "Die Datei " & """" & (Worksheets("Worddaten").Range("B24")) & """" & " wurde geschlossen!"
Label39.Caption = vbLf & vbLf & "  Bitte neue Auswahl treffen oder mittels Button ""Beenden"" das Formular schliessen!"
'Ende - zu erledigende Aufgaben
Exit Sub
End If
Loop While Eingabe = vbNullString
strDokNeu2 = ZielPfad & DatName & Eingabe & ".docx" 'strPfad & strDokName & Eingabe & strEndung
'Debug.Print strDokNeu2
'schreibgeschützt   'damit wird Dokument1 unter vorgegebenem Namen schreibgeschützt gespeichert
WrdApp.ActiveDocument.SaveAs Filename:=ZielPfad & DatName & Eingabe & ".docx", FileFormat:= _
wdFormatDocument, LockComments:=False, Password:="", AddToRecentFiles:= _
True, WritePassword:="", ReadOnlyRecommended:=True, EmbedTrueTypeFonts:= _
False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
SaveAsAOCELetter:=False
Label39.Font.Size = 12
Label39.Caption = "Das Dokument wurde im Ordner: " & strDokNeu2 & " schreibgeschützt - gespeichert!"
'Anfang WordDoc schliesen und ggf. Word beenden
If Not WrdApp Is Nothing Then
wrdDoc.Close 0
If WrdApp.Documents.Count = 0 Then WrdApp.Quit
Set wrdDoc = Nothing
Set WrdApp = Nothing
End If
With Label39
.BackColor = &HC0FFC0
.Caption = "Die Datei " & """" & strDName & """" & " wurde geschlossen!"
End With
CommandButton14.Enabled = False
CommandButton15.Enabled = False
'Ende WordDoc schliesen und ggf. Word beenden
'Anfang - zu erledigende Aufgaben
'da Dokument1 unter neuem Namen in Ordner "Dokumente" gespeichert wird, muss u.a. Makro ausgeführt werden
Call Word_Vorlagen_Laufend_auflisten
Call ListBox3_aktualisieren
CommandButton13 = True
ListBox2.Enabled = True
CommandButton8 = True   'Auswahl löschen
Label31.Caption = "Die Datei " & """" & (Worksheets("Worddaten").Range("B24")) & """" & " wurde geschlossen!"
Label39.Caption = vbLf & vbLf & "  Bitte neue Auswahl treffen oder mittels Button ""Beenden"" das Formular schliessen!"
'Ende - zu erledigende Aufgaben
End If
'Ende nochmalige Prüfung für strFile2
Else
Label39.Font.Size = 12
Label39.Caption = "Abbruch - das Dokument wurde nicht gespeichert"
.Close False
If WrdApp.Documents.Count = 0 Then WrdApp.Quit      'beendet Word nur wenn kein weiteres Word geöffnet ist
CommandButton14.Enabled = False
CommandButton15.Enabled = False
'Anfang - zu erledigende Aufgaben
'da Dokument1 unter neuem Namen in Ordner "Dokumente" gespeichert wird, muss u.a. Makro ausgeführt werden
Call Word_Vorlagen_Laufend_auflisten
Call ListBox3_aktualisieren
CommandButton13 = True
ListBox2.Enabled = True
CommandButton8 = True   'Auswahl löschen
Label31.Caption = "Die Datei " & """" & (Worksheets("Worddaten").Range("B24")) & """" & " wurde geschlossen!"
Label39.Caption = vbLf & vbLf & "  Bitte neue Auswahl treffen oder mittels Button ""Beenden"" das Formular schliessen!"
'Ende - zu erledigende Aufgaben
End If  'End if für Msgbox("Wollen Sie
End If  'End if für Dir(strDokNeu)
End With    'End with für wrdDoc
ListBox2.ListIndex = -1
CommandButton2.Enabled = True
On Error GoTo 0
End Sub
'Dokument öffnen
Private Sub CommandButton18_Click()
'Wichtig! Die Deklarationen müssen damit CommandButton18 richtig ausgeführt wird für alles in der Zeile direkt unter Option Explicit stehen
'Dim WrdApp As Object
'Dim wrdDoc As Object
Dim pfad As String
Dim strDName As String
Dim PflichtName As String  'neu für Pflichtfeld
Application.ScreenUpdating = False
'Hier wird der Dateiname der WORD-Vorlage erstellt - bitte anpassen !
pfad = ThisWorkbook.Path & "\"    'von Gerhard 2021_04_23
'Debug.Print Pfad
strDName = pfad & ListBox3.Value
'Debug.Print strDName
If ListBox3.ListIndex = -1 Then
Label31.Font.Size = 14
Label31.Caption = vbLf & "             bitte ein Dokument auswählen"
Exit Sub
Else
Set WrdApp = CreateObject("Word.Application")
WrdApp.Visible = True
WrdApp.WindowState = 1 '0 = Normal; 1 = Maximized; 2 = Minimized
Application.EnableEvents = False    'aus - verhindert die Ausführung von Makros
Set wrdDoc = WrdApp.Documents.Open(strDName)
'''''        wrdDoc.SelectContentControlsByTag("Pflichtfeld").Item(1).Range = "Test"
'''''        wrdDoc.SelectContentControlsByTag("Pflichtfeld").Item(1).Range = "Carl-von-Linde-Gymnasium"
wrdDoc.SelectContentControlsByTag("Pflichtfeld").Item(1).Range = PflichtName
Application.EnableEvents = True    'ein - verhindert die Ausführung von Makros
Label39 = ""
Label31.Font.Size = 13
Label31.Caption = vbLf & "                 Dokument wurde geöffnet"
CommandButton18.Enabled = False
CommandButton27.Enabled = True
wrdDoc.Activate
End If
End Sub
'Word-Dokument schliessen
Private Sub CommandButton27_Click()
'Wichtig! Die Deklarationen müssen damit CommandButton27 richtig ausgeführt wird für alles in der Zeile direkt unter Option Explicit stehen
'Dim WrdApp As Object
'Dim wrdDoc As Object   'für öffnen der Wordvorlage
Dim PflichtName As String  'neu für Pflichtfeld
Application.ScreenUpdating = False
On Error Resume Next    'benötigt für Prüfung ob ein Worddokument geöffnet ist
If Err.Number  70 Then    'benötigt für Prüfung ob ein Worddokument geöffnet ist
'Anfang WordDoc schliesen und ggf. Word beenden
If Not WrdApp Is Nothing Then
'            wrdDoc.SelectContentControlsByTag("Pflichtfeld").Item(1).Range = "Test1"
wrdDoc.SelectContentControlsByTag("Pflichtfeld").Item(1).Range = PflichtName
wrdDoc.Close 0
If WrdApp.Documents.Count = 0 Then WrdApp.Quit
Set wrdDoc = Nothing
Set WrdApp = Nothing
End If
With Label31 'Label39
.BackColor = &HC0FFC0
.Caption = vbLf & "                 Die Datei ist geschlossen!" '"Die Datei " & """" & strDName & """" & " wurde geschlossen!"
End With
CommandButton18.Enabled = True
CommandButton27.Enabled = False
'Ende WordDoc schliesen und ggf. Word beenden
CommandButton17 = True
Else    'benötigt für Prüfung ob ein Worddokument geöffnet ist
If Not WrdApp Is Nothing Then
If WrdApp.Documents.Count = 0 Then WrdApp.Quit
Set wrdDoc = Nothing
Set WrdApp = Nothing
With Label31 'Label39
.BackColor = &HC0FFC0
.Caption = vbLf & "                 Die Datei ist geschlossen!"
End With
CommandButton18.Enabled = True
CommandButton27.Enabled = False
ListBox3.ListIndex = -1
End If
End If
On Error GoTo 0    'benötigt für Prüfung ob ein Worddokument geöffnet ist
Application.ScreenUpdating = True
End Sub
Vermutlich wird auf dem anderen Rechner das Dokument1 nicht richtig mit Werten gespeichert.
Könnt ihr mir bitte helfen, wo sich der Fehler befindet?
Gruss
Peter

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Problem beim Öffnen Worddokument aus Exc
06.11.2021 13:52:23
Nepumuk
Hallo Peter,
ersetze:

Dim wdFormatDocument
durch:

Const wdFormatDocument As Long = 12
Gruß
Nepumuk
AW: Problem beim Öffnen Worddokument aus Exc
06.11.2021 14:46:49
Peter
Hallo Nepumuk,
leider ohne Erfolg.
Das Problem ist, dass das gespeicherte Word-Dokument trotzdem dieses als "docx" gespeichert ist nicht mit gespeicherten Werten öffnet sondern offensichtlich ein Makro ausführt und angibt, ohne Bezüge.
Dies obwohl durch die Zeile "Application.EnableEvents = False 'aus - verhindert die Ausführung von Makros" verhindert werden soll, dass Makros ausgeführt werden.
Wenn ich das Worddokument im bisherigen Rechner aus dem Ordner heraus öffne, kommt lediglich die Abfrage: Der Ersteller wünscht, dass das Dokument schreibge-schützt öffnet... bei ja wird das Dokument geöffnet mit den gespeicherten Werten.
Wenn ich das Dokument im neuen Rechner öffne kommt zuerst die gleiche Abfrage und nach ja kommt eine erneute Abfrage:
Das Dokument enthält Verknüpfungen, die möglicherweise auf andere Dateien verweisen, Möchten Sie das Dokument aus den verknüpften Daten aktualisieren?
Warum? Ich habe keine Erklärung. Hast Du eine Ahnung?
Gruss
Peter
Anzeige
AW: Bilder anbei
06.11.2021 15:08:03
Peter
Hallo Nepumuk,
ich füge noch Bilder bei wie dies bei mir aussieht:
Anbei Bilder:
Userbild
Userbild
Userbild
Vielleicht nützt dir das etwas.
AW: Problem beim Öffnen Worddokument aus Exc
06.11.2021 15:09:13
Peter
Hallo Nepumuk,
habe vergessen zu aktivieren.
AW: Problem beim Öffnen Worddokument aus Exc
06.11.2021 18:07:52
Luschi
Hallo Peter,
bei mir (Word 2019) hat 'wdFormatDocument' den Wert '0', also:
Const wdFormatDocument As Long = 0
Gruß von Luschi
aus klein-Paris
Anzeige

143 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige