VBA Passwort Abfrage nach Beenden von Excel

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

der Code hat so 30 A4 Seiten... Also am besten sagst mir was du davon am liebsten möchtest...

Na das fertige Tool, XLS, XLSM, XLAM, was auch immer, bzw. mehrere davon. Und zwar im Auslieferungszustand, also so geschützt wie es der User bekommt. Inkl. Install-/Bedienungs-Anleitung, falls es eine gibt.

Nur das/die kann ich auf meinen Maschinen probieren und kucken ob es einen Fehler bringt. Wenn ja, dann kann ich schauen ob dieser a) nachvollziehbar und b) woher er kommt.... wenn es sich denn rausfinden läßt.

Ist die Ecke gefunden dann ist immer noch fraglich ob es überhaupt am VBA-Code liegt, das muss nämlich gar nicht sein! Und selbst wenn, ist ein Workaround möglich...

Andreas.

Ich benutze als einzige Windows API den Registry Zugriff.

Hmm, benutze ich nie, es sei denn die in VBA eingebauten Routinen. Ich kenn Excel seit 95 und hatte das Problem noch nie... allerdings haben meine VBA-Projekte auch nur sehr selten ein Passwort... find ich unnützt.

Zeig doch mal so ein Tool, kann ich ja mal reinkucken.

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?