leider ist meine Suche in Google nicht erfolgreich.
Ich habe den nachfolgenden Code. Mein Problem ist das Beenden der Exceldatei ohne Speicherung und ohne Meldung. Was mache ich hier bitte falsch?
Option Explicit
Private Sub Workbook_Open()
Dim wb As Workbook 'benötigt für dieses Workbook
Dim wsWd As Worksheet 'benötigt für Tabelle Worddaten
Dim PfadOrdnerIst As String 'benötigt für Auslesen aktueller Ordnername aus Pfad
Dim PfadOrdnerSoll As String 'benötigt für Auslesen benötigter Ordnername aus Pfad
Dim DatNameIst As String 'benötigt für Auslesen aktueller Dateiname
Dim DatNameSoll As String 'benötigt für Auslesen benötigter Dateiname
Application.ScreenUpdating = False
On Error Resume Next
Application.WindowState = xlMaximized 'das Anwendungsfenster in Microsoft Excel _
maximiert
ActiveWindow.WindowState = xlMaximized 'das aktive Fenster wird maximiert
'Anfang Prüfung, ob diese Datei und dieser Ordner umbenannt sind, wenn nicht dann Exit Sub _
und Meldung:
Set wb = ThisWorkbook
Set wsWd = wb.Worksheets("Worddaten")
With wsWd
PfadOrdnerIst = .Range("B65").Value
PfadOrdnerSoll = .Range("B62").Value
DatNameIst = .Range("B10").Value
DatNameSoll = .Range("B63").Value
End With
'Debug.Print PfadOrdnerIst
'Debug.Print PfadOrdnerSoll
'Debug.Print DatNameIst
'Debug.Print DatNameSoll
'i.O.
If PfadOrdnerIst = PfadOrdnerSoll And DatNameIst = DatNameSoll Then 'Ordnernamen und _
Dateinamen sind identisch
'UF_00_PrüfungKontoBasis.Show 'nicht erforderlich, da beide identisch
Call Datei_prüfen_öffnen
'i.O.
ElseIf PfadOrdnerIst PfadOrdnerSoll And DatNameIst = DatNameSoll Then 'Ordnernamen _
nicht identisch und Dateinamen ist identisch
UF_00_PrüfungKontoBasis.Show
Application.ScreenUpdating = True
Set wb = Nothing
Set wsWd = Nothing
' Exit Sub 'Später Datei ohne Speichern beenden Excel beenden
'Anfang Excel beenden ohne Speichern, Excel beenden, wenn keine weitere geöfnet ist
If Application.Workbooks.Count > 1 Then
Application.DisplayAlerts = False
Calculate
'ThisWorkbook.Save
ThisWorkbook.Close False
Exit Sub
ElseIf Application.Workbooks.Count = 1 Then
Application.DisplayAlerts = False
Calculate
'ThisWorkbook.Save
''ThisWorkbook.Close 'darf nicht aktiviert werden
Application.Quit
Application.DisplayAlerts = True
End If
'Ende Excel beenden ohne Speichern, Excel beenden, wenn keine weitere geöfnet ist
'i.O.
ElseIf PfadOrdnerIst = PfadOrdnerSoll And DatNameIst DatNameSoll Then 'Ordnernamen _
sind identisch und Dateinamen sind nicht identisch
UF_00_PrüfungKontoBasis.Show
Application.ScreenUpdating = True
Set wb = Nothing
Set wsWd = Nothing
'Exit Sub 'Später Datei ohne Speichern beenden Excel beenden
'Anfang Excel beenden ohne Speichern, Excel beenden, wenn keine weitere geöfnet ist
If Application.Workbooks.Count > 1 Then
Application.DisplayAlerts = False
Calculate
'ThisWorkbook.Save
ThisWorkbook.Close False
Exit Sub
ElseIf Application.Workbooks.Count = 1 Then
Application.DisplayAlerts = False
Calculate
'ThisWorkbook.Save
''ThisWorkbook.Close 'darf nicht aktiviert werden
Application.Quit
Application.DisplayAlerts = True
End If
'Ende Excel beenden ohne Speichern, Excel beenden, wenn keine weitere geöfnet ist
'i.O.
ElseIf PfadOrdnerIst PfadOrdnerSoll And DatNameIst DatNameSoll Then 'Ordnernamen _
sind nicht identisch und Dateinamen sind nicht identisch
UF_00_PrüfungKontoBasis.Show
Application.ScreenUpdating = True
Set wb = Nothing
Set wsWd = Nothing
' Exit Sub 'Später Datei ohne Speichern beenden Excel beenden
'Anfang Excel beenden ohne Speichern, Excel beenden, wenn keine weitere geöfnet ist
If Application.Workbooks.Count > 1 Then
Application.DisplayAlerts = False
Calculate
'ThisWorkbook.Save
ThisWorkbook.Close False
Exit Sub
ElseIf Application.Workbooks.Count = 1 Then
Application.DisplayAlerts = False
Calculate
'ThisWorkbook.Save
''ThisWorkbook.Close 'darf nicht aktiviert werden
Application.Quit
Application.DisplayAlerts = True
End If
'Ende Excel beenden ohne Speichern, Excel beenden, wenn keine weitere geöfnet ist
End If
'Ende Prüfung, ob diese Datei und dieser Ordner umbenannt sind, wenn nicht dann Exit _
Sub und Meldung:
Application.ScreenUpdating = True
Set wb = Nothing
Set wsWd = Nothing
End Sub
Besten Dank für eure Hilfe.Gruss
Peter