Excel VBA-Passwort Abfrage beim Schliessen

Hallo Andreas

Besten Dank für die prompte Antwort.

Zu deiner Frage bezüglich der Datei muss ich dir hier leider ebenfalls das gleiche mitteilen. Es handelt sich um vertrauliche Daten, Preise und weitere Informationen, welche ich nicht weitergeben kann und darf.

Vor dem schliessen eine zweite Datei zu öffnen, scheint mir leider nicht gerade nach einer sauberen und langfristigen Lösung. Das Toll wird täglich mehrere Male verwendet und muss einwandfrei, ohne solche ICH-KANNS-NICHT-BESSER-WORKAROUNDS funktionieren.
Aus diesem Grund und meiner persönlichen Abneigung gegenüber solchen Tricks kommt diese Lösung für mich leider nicht in Frage, obwohl sie zugegebenermassen attraktiv und simpel erscheint.

Wenn du das Projekt nun auseinander nehmen müsstest, wo würdest du beginnen?

Ich habe im Internet recherchiert und herausbekommen, dass solche Probleme im Zusammenhang mit dem PDFViewer von Adobe oft auftreten. Leider kann ich auf dieses Add-IN aber nicht verzichten.

Beim Schliessen des Dokuments, wird folgender Code durchlaufen:

- Alle Sheets bis auf eines auf xlveryhidden stellen.

- Alle UF's unloaden

- Shut-Down UF anzeigen.

- Dokument schliessen, ohne speicher (da zuvor; saved=true)

Hoffe diese Infos helfen Dir, Euch weiter.

MfG

Hatten wir letztens schon mal:

https://answers.microsoft.com/de-de...on-excel/93349722-7194-40a1-98a3-c9e700d527e7

Stand der Dinge: Ich warte immer noch auf die Datei.

Aber wenn sich das Problem mit einem 2ten geöffnetem Dokument vermeiden läßt, warum dann nicht einfach vor dem Schließen des eigenen Projektes ein neues erzeugen?

Erscheint mir einfacher als das ganze Projekt auseinanderzunehmen...

Andreas.

kommt diese Lösung für mich leider nicht in Frage

Datei gibt es nicht...

einen möglichen Workaround willst Du generell nicht...

woran es liegen könnte darf auch nicht anders sein...

Beiß ihm ins Genick, reiß den Kopf ab und spuck ihn aus, das meine ich mit Auseinandernehmen... Wort wörtlich.

Wenn Du da zimperlich dran gehst und von vorn herein Grenzen setzt... vergiß es, spar Dir die Arbeit.

Andreas.

Gerne aber ich darf auch die geschützten Dateien nicht einfach hier präsentieren, da sie frei kopierbar sind. Gibt es eine Möglichkeit dir einen Download-Link direkt zu schicken?

In meinem Profil steht meine eMail.

Hallo Andreas,

die Tools sind urheberrechtlich geschützt, deshalb das Passwort. Das Urheberrecht liegt aber nicht bei mir ich bin nur der Programmierer. Ich kann dir also hier nur Abschnittsweise was einstellen, habe aber keine ernsthafte Ahnung in welcher Ecke das Problem
steckt. Immer wenn ich es provozieren will, macht es ja keinen Fehler... Die Module haben durchschnittlich 6 Formulare, mehrere Tabellen und Mindestens 6 gut gefüllte Module. Ich denke der Code hat so 30 A4 Seiten... Also am besten sagst mir was du davon am
liebsten möchtest...

Ich beginne mal mit dem Inhalt von DieseArbeitsmappe, wo einige Events drin sind. Nicht wundern, in beforeclose sind schon einige Workarounds drin, die diesen Bug und den Bug dass die Programme im Hintergrund geöffnet bleiben beseitigen sollen.

Option Explicit
Private Sub Workbook_Open()

On Error GoTo HandleErr

Copyright.Show

Call GanzeBreite

Call GoPos1

Worksheets("Betreuungszeiten").ScrollArea = "a1:bz250"

Worksheets("Diagramm").ScrollArea = "a1:m50"

With Application

.OnKey "{F2}", ""

.OnKey "{F3}", "Erweitern"

.OnKey "{F4}", "Selectioncheck"

.OnKey "{F5}", "Zoom1"

.OnKey "{F6}", "Zoom2"

.OnKey "{F7}", "Zoom3"

.OnKey "{F8}", "GanzeBreite"

.OnKey "{F10}", ""

.OnKey "{F11}", ""

.OnKey "{Home}", "GoPos1"

.OnKey "{End}", "Ende"

.DefaultSaveFormat = xlOpenXMLWorkbookMacroEnabled

End With

Worksheets("Betreuungszeiten").Activate

ActiveSheet.Range("a1").Select

ActiveSheet.EnableSelection = xlUnlockedCells

ExitHere:

Exit Sub
' Fehlerbehandlungsblock hinzugefügt vom Fehlerbehandlungsroutinen-Add-In. Bearbeiten Sie diesen Codeabschnitt NICHT.

' Automatische Fehlerbehandlungsroutine wurde zuletzt aktualisiert: 04-20-2004 17:45:36 'ErrorHandler:$$D=04-20-2004 'ErrorHandler:$$T=17:45:36

HandleErr:

Select Case Err.Number

Case Else

MsgBox "Fehler " & Err.Number & ": " & Err.description, vbCritical, "DieseArbeitsmappe.Workbook_Open" 'ErrorHandler:$$N=DieseArbeitsmappe.Workbook_Open

End Select

' Ende des Fehlerbehandlungsblocks.

End Sub
Private Sub Workbook_Activate()

'Symbolleisten merken und ausblenden

On Error GoTo HandleErr

Call Arbeitsumgebung

Worksheets("Betreuungszeiten").Activate 'notwendig, um F-Tastenfunktionen wiederherzustellen

With Application

.OnKey "{F2}", ""

.OnKey "{F3}", "Erweitern"

.OnKey "{F4}", "Selectioncheck"

.OnKey "{F5}", "Zoom1"

.OnKey "{F6}", "Zoom2"

.OnKey "{F7}", "Zoom3"

.OnKey "{F8}", "GanzeBreite"

.OnKey "{F10}", ""

.OnKey "{F11}", ""

.OnKey "{Home}", "GoPos1"

.OnKey "{End}", "Ende"

.OnKey "+^{f}", "Blattfreigabe"

.OnKey "+^{s}", "Blattschutz"

.OnKey "+^{d}", "Diagrammschutz"

End With

ActiveSheet.EnableSelection = xlUnlockedCells

ActiveSheet.PageSetup.PrintArea = gconDruckbereich

ExitHere:

Exit Sub
' Fehlerbehandlungsblock hinzugefügt vom Fehlerbehandlungsroutinen-Add-In. Bearbeiten Sie diesen Codeabschnitt NICHT.

' Automatische Fehlerbehandlungsroutine wurde zuletzt aktualisiert: 05-25-2002 17:36:32 'ErrorHandler:$$D=05-25-2002 'ErrorHandler:$$T=17:36:32

HandleErr:

Application.EnableEvents = True

Application.ScreenUpdating = True

Select Case Err.Number

Case Else

MsgBox "Fehler " & Err.Number & ": " & Err.description, vbCritical, "DieseArbeitsmappe.Workbook_Activate" 'ErrorHandler:$$N=DieseArbeitsmappe.Workbook_Activate

End Select

' Ende des Fehlerbehandlungsblocks.

End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

On Error GoTo HandleErr

If Application.CutCopyMode = xlCut Then 'Ausschneiden verhindern

MsgBox ("Ausschneiden nicht möglich")

Application.CutCopyMode = False

End If

ExitHere:

Exit Sub
' Fehlerbehandlungsblock hinzugefügt vom Fehlerbehandlungsroutinen-Add-In. Bearbeiten Sie diesen Codeabschnitt NICHT.

' Automatische Fehlerbehandlungsroutine wurde zuletzt aktualisiert: 05-25-2002 17:36:32 'ErrorHandler:$$D=05-25-2002 'ErrorHandler:$$T=17:36:32

HandleErr:

Application.EnableEvents = True

Application.ScreenUpdating = True

Select Case Err.Number

Case Else

MsgBox "Fehler " & Err.Number & ": " & Err.description, vbCritical, "DieseArbeitsmappe.Workbook_SheetSelectionChange" 'ErrorHandler:$$N=DieseArbeitsmappe.Workbook_SheetSelectionChange

End Select

' Ende des Fehlerbehandlungsblocks.

End Sub

Private Sub Workbook_Deactivate()

Call UndoUmgebung

With Application

.OnKey "{F2}", ""

.OnKey "{F3}", ""

.OnKey "{F4}", ""

.OnKey "{F5}", ""

.OnKey "{F6}", ""

.OnKey "{F7}", ""

.OnKey "{F8}", ""

.OnKey "{F9}", ""

.OnKey "{F10}", ""

.OnKey "{Home}", ""

.OnKey "{End}", ""

.OnKey "+^{f}", ""

.OnKey "+^{s}", ""

.OnKey "+^{d}", ""

End With

End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)

Dim CountPersonal_XL As Integer

Dim oWB As Excel.Workbook

Dim intAntwort As Integer

'Fehler Passwortabfrage beim schließen beseitigen

If Not ThisWorkbook.Saved = True And Not gbolStartetclose = True Then

gbolStartetclose = True

Select Case MsgBox("Wollen Sie speichern vor dem Beenden?", vbYesNo Or vbQuestion Or vbDefaultButton1, "Bedarfsentwicklung")

Case vbYes

ThisWorkbook.Save

Case vbNo

End Select

End If

ThisWorkbook.Saved = True

'Wenn kein weiteres Excel geöffnet, dann Excel ganz schließen. Beugt Fehler des doppelten öffnens vor

For Each oWB In Workbooks

If InStr(oWB.Name, "PERSONAL.XLS") > 0 Then

CountPersonal_XL = 1

Exit For

End If

Next

Set oWB = Nothing

'Set gobjRibbon = Nothing

If Workbooks.Count - CountPersonal_XL = 1 Then

Application.Quit

End If

End

End Sub