|
37. Datei kann nur X mal geöffnet werden
Aufgabenstellung:
Eine
Datei sollte nur 5 mal geöffnet werden können.
Nachdem die Datei 5 mal geöffnet wurde, sollte
ein erneutes Öffnen nur durch ein Passwort
geschehen können. Außerdem sollte bei
erfolgreicher Passworteingabe der komplette VBA
Code, der für die Überprüfung der
Öffnungsversuche benötigt wird, automatisch
gelöscht werden.
Dieses Beispiel steht auch als
Beispieldatei
zum Download zur Verfügung.
|
|
Realisiert wurde das durch eine VBA-Lösung.
Der Code ist in das VBA Projekt
DieseArbeitsmappe
einzufügen.
Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Das Blatt "Zaehlblatt1" wird eingeblendet
Sheets("Zaehlblatt1").Visible = True
'Das Blatt "Tabelle1" wird ausgeblendet
Sheets("Tabelle1").Visible = xlVeryHidden
'Das Blatt "Tabelle1" wird ausgeblendet
Sheets("Zaehlblatt").Visible = xlVeryHidden
'Die deaktivierten Funktionen in den Symbolleisten werden
'wieder eingeblendet
Symbolleisten_Aktivieren
'Speicherabfrage wird beim Beenden unterdrückt und die
'Datei wird gespeichert.
ThisWorkbook.Close True
End Sub
Private Sub Workbook_Open()
'Den Variablen "Anz" und "Versuche" werden ihrem
'Variablentyp zugewiesen
Dim Anz As String, Versuche As Integer
'Div. Funktionen werden in den Symbolleisten deaktiviert
Symbolleisten_Deaktivieren
'Wert, wie oft die Datei geöffnet werden darf
Versuche = 5
'In Blatt Zaehlblatt in Zelle D1 wird die Zahl 1 addiert
Worksheets("Zaehlblatt").Cells(1, 4).Value = _
Worksheets("Zaehlblatt").Cells(1, 4).Value + 1
'Berechnung des Wertes 5 minus des Wertes aus Zelle D1 in
'Blatt "Zaehlblatt"
Wert = Versuche - Worksheets("Zaehlblatt") _
.Range("D1")
'Wenn der Wert in Zelle D1 in Blatt "Zaehlblatt"
'größer x dann ....
If Worksheets("Zaehlblatt").Range("D1") <= Versuche Then
'Messagebox zeigt an, wie oft die Datei noch geöffnet
'werden kann
MsgBox "Sie können die Datei noch " & Wert & "x öffnen" & Chr(13) & Chr(13) _
& "Danach benötigen Sie ein Passwort, um mit dieser Datei weiterarbeiten zu können." & Chr(13) & Chr(13) _
& "Das Passwort können Sie unter Klaus@Mustermann.de bestellen."
'Das Blatt "Tabelle1" wird eingeblendet
Sheets("Tabelle1").Visible = True
'Das Blatt "Zaehlblatt" wird ausgeblendet
Sheets("Zaehlblatt1").Visible = xlVeryHidden
'In Zelle E3 die Anzahl der noch verbleibenden Öffnungen schreiben
Range("E3") = Wert
Else
'Messagebox aufrufen
MsgBox "Sie haben Ihre " & Versuche & " Versuche verbraucht. Um die Datei wieder öffnen" & Chr(13) & Chr(13) _
& " zu können, benötigen Sie ab jetzt ein Passwort. Das Passwort können Sie" & Chr(13) & Chr(13) _
& " unter Klaus@Mustermann.de bestellen."
'Eingabefenster für Passworteingabe öffnen
If InputBox("Bitte Paßwort eingeben!", "Abfrage") = "Passwort" Then
'Ist das Passwort richtig wird das Blatt "Tabelle1" wird eingeblendet
Sheets("Tabelle1").Visible = True
'Blatt "Tabelle1" wird aktiviert
Sheets("Tabelle1").Select
'Makro "Tabellenblätter_einblenden" ausführen
Tabellenblätter_einblenden
'Makro "Tabellenblätter_löschen" ausführen
Tabellenblätter_löschen
'Makro "Symbolleisten_aktivieren" ausführen
Symbolleisten_Aktivieren
'Befehl muss vorhanden sein, damit nachfolgende Anweisung
'abgearbeitet werden kann
DoEvents
'Makro "Passwort_aus" wird ausgeführt
Passwort_aus
'Befehl muss vorhanden sein, damit nachfolgende Anweisung
'abgearbeitet werden kann
DoEvents
'Makro "LöschMakro" wird ausgeführt
LöschMakro
Else
'Ist das Passwort falsch, wird die Datei geschlossen
ActiveWorkbook.Close False
'Abfrage Ende
End If
'Abfrage Ende
End If
End Sub
Sub LöschMakro()
'Löscht bei erfolgreicher Eingabe des Passwortes 126 Zeilen
'des Codes ab Zeile 1, also alles auf dieser Seite
Application.VBE.ActiveVBProject.VBComponents(1). _
CodeModule.DeleteLines 1, 227
End Sub
Sub Passwort_aus()
' Hinweise für die Keys
' % = Alt
' ^ = Strg
' + = Shift
'Visual Basic öffnen
SendKeys "%{F11}"
'Extras/Eigenschaften
SendKeys "%xi"
'Passwortabfrage
SendKeys "Passwort"
'Passw. abschicken
SendKeys "{enter}"
'Eigenschaftsfenster verlassen
SendKeys "{esc}"
'VBA Umgebung beenden
SendKeys "%dh"
End Sub
Sub Tabellenblätter_einblenden()
'Das Blatt "Zaehlblatt" wird eingeblendet
Sheets("Zaehlblatt").Visible = True
'Das Blatt "Zaehlblatt1" wird eingeblendet
Sheets("Zaehlblatt1").Visible = True
End Sub
Sub Zähler_löschen()
'Der Bereich C1 bis C50 wird markiert....
Worksheets("Zaehlblatt").Range("D1").ClearContents
End Sub
Sub Tabellenblätter_löschen()
'Abfrage, ob Tabellenblätter gelöscht werden sollen,
'wird deaktiviert
Application.DisplayAlerts = False
'Die Tabellenblätter "Zaehlblatt" und "Zaehlblatt1"
'werden gelöscht
Sheets(Array("Zaehlblatt", "Zaehlblatt1")).Delete
'Abfrage, ob Tabellenblätter gelöscht werden sollen,
'wird aktiviert
Application.DisplayAlerts = True
End Sub
Sub Symbolleisten_Aktivieren()
With Application
'Das RollUp Menü, was beim Betätigen der rechten
'Maustaste erscheint wird aktiviert
.CommandBars("Toolbar List").Enabled = True
'Die Funktion "Anpassen" Im Menüpunkt "Extras"
'wird aktiviert
.CommandBars("Worksheet Menu Bar"). _
Controls("Extras").Controls("Anpassen...").Enabled = True
'Die Funktion "Makro" Im Menüpunkt "Extras" wird aktiviert
.CommandBars("Worksheet Menu Bar"). _
Controls("Extras").Controls("Makro").Enabled = True
End With
End Sub
Sub Symbolleisten_Deaktivieren()
'Die Symbolleiste "Steuerelement/Toolbox" wird
'deaktiviert falls geöffnet
Application.CommandBars("Control Toolbox").Visible = False
'Die Symbolleiste "Visual Basic" wird deaktiviert
'falls geöffnet
Application.CommandBars("Visual Basic").Visible = False
With Application
'Das RollUp Menü, was beim Betätigen der rechten Maustaste
'erscheint wird deaktiviert
.CommandBars("Toolbar List").Enabled = False
'Die Funktion "Anpassen" Im Menüpunkt "Extras" wird deaktiviert
.CommandBars("Worksheet Menu Bar"). _
Controls("Extras").Controls("Anpassen...").Enabled = False
'Die Funktion "Makro" Im Menüpunkt "Extras" wird deaktiviert
.CommandBars("Worksheet Menu Bar"). _
Controls("Extras").Controls("Makro").Enabled = False
End With
End Sub
|
Dieses Beispiel wurde unter den in der
Tabelle aufgeführten Versionen getestet.
|
|
A |
B |
C |
D |
E |
|
1 |
|
|
|
|
|
2 |
|
Excel - Version |
Getestet |
|
|
3 |
|
|
|
|
4 |
|
Excel 2007 |
12.0 |
a |
|
|
5 |
|
Excel 2003 |
11.0 |
a |
|
|
6 |
|
Excel 2002 |
10.0 |
a |
|
|
7 |
|
Excel 2000 |
9.0 |
a |
|
|
8 |
|
Excel 97 |
8.0 |
|
|
|
9 |
|
|
|
|
|
|
10 |
|
Anzahl der Downloads: |
|
|
|
11 |
|
|
|
|
|
|
12 |
|
Dieses Beispiel wurde bereits
x
aufgerufen. |
|
|
13 |
|
|
|
14 |
|
|
|
|
|
|
>
Beispieldatei herunterladen
<
Sollten beim Ausführen der Beispieldatei Fehler
auftreten, bitte ich darum, mir eine Mail mit der
Fehlerbeschreibung an
fehler@excelbeispiele.de
zu schicken.
Danke!
Möchten Sie www.excelbeispiele.de in Ihre Favoriten aufnehmen? Dann Klicken Sie hier.
|
|