VBA: Fehler Behandulung
14.01.2020 12:15:11
Charly
habe ein Problem mit Fehlerbehandlung/Abfrage in einer ComboBox in einer UF.
Zur Erläuterung:
Der Benutzer wählt einen Eintrag "Tabelle1" od. "Tabelle2" in der ComboBox aus. ----Funktioniert-----
Wenn der Benutzer "Word-Dokument" anklicke wird das Dokument verarbeitet
u. Gedruckt im Anschluss ohne zu speichern geschlossen. ----Funktioniert-----
Nun zu meinem Problem:
Wenn z.B. der Benutzer das "Word-Dokument" Versehendlich angeklickt u. den Eintrag in der ComboBox wechselt in z.b. "Tabelle1" soll folgendes Passieren:
1. Prüfe ob das Word-Dokument offen ist,
2. wenn ja dann Schließe das Dokument ohne zu speichern,
3. wenn nein dann fahre mit der Prozedur fort.
Bin seit heut Morgen an dem Problem dran, auch Google kam zum Einsatz. Leider ohne Erfolg.
Die Sub´s "öffnen, schleißen, Schließen1" sind im gleichem Modul.
Wie kann Ich das Problem beheben?
Code im Button:
Private Sub CBx_TabAuswahl_Click()
If CBx_TabAuswahl.Value = "Tabelle1" = True Then
Call M_UF2_Word.schließen1
'Tabellenblatt "Tabelle1" ausgewählt
Tabelle6.Activate
ElseIf CBx_TabAuswahl.Value = "Tabelle2" = True Then
Call M_UF2_Word.schließen1
'Tabellenblatt "Tabelle2" ausgewählt
Tabelle7.Activate
ElseIf CBx_TabAuswahl.Value = "Dokument" = True Then
'Tabellenblatt "Dokument" ausgewählt
Call M_UF2_Word.öffnen
ThisWorkbook.Activate
Else
End If
End Sub
Option Explicit
Dim appWord As Object
Dim DocTest As Object
Dim strFile As String
Dim iClick As Variant
Sub öffnen()
Set appWord = CreateObject("Word.Application")
strFile = "file:///P:Downloads/Dokument1.docx"
Set DocTest = appWord.Documents.Open(strFile, ReadOnly:=True)
appWord.Visible = True
If DocTest.ProtectionType Then
DocTest.unprotect password:="0001"
End If
End Sub
Sub schließen()
appWord.PrintOut
DocTest.Close SaveChanges:=False
appWord.Quit
Set DocTest = Nothing
Set appWord = Nothing
End Sub
Schließe das Dokument bei Falsch Auswahl in der ComboBox ohne Speichern
Sub schließen1()
DocTest.Close SaveChanges:=False
appWord.Quit
Set DocTest = Nothing
Set appWord = Nothing
End Sub
Gruß Charly
Anzeige