Verfallsdatum passwortgeschützt

Private Sub Workbook_Open() Application.ScreenUpdating = False Menü.Show 'vbModeless Application.ScreenUpdating = True Dim verfall As Date 'Zeile 11 ab hier soll bei richtiger Passworteingabe gelöscht werden verfall = CDate("14.05.2018") If verfall "123" Then MsgBox " Die Registrierungsnummer ist ungültig," & Chr(13) & Chr(13) & " das _ Programm wird geschlossen!" ThisWorkbook.Close LöschMakro End If End If 'Zeile 25 bis hier soll gelöscht werden End Sub Sub LöschMakro() Application.VBE.ActiveVBProject.VBComponents(10). _ CodeModule.DeleteLines 11, 25 End Sub Hoffe sehr auf eure Hilfe und bedanke mich schon einmal im voraus. VG Heike

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Heike,
das Ändern des VBA-Codes kann Probleme bereiten:
1. Unter den Sicherheitseinstellungen muss der Zugriff auf das VBA-Modul erlaubt werden.
Diese Einstellung muss der jeweilige Anwender machen.
2. ggf. muss das Kennwort für den Zugriff auf das VBA-Projekt der Datei eingegeben werden.
Als Alternative kann mit einem ausgeblendeten Namen arbeiten, um den Zugriff auf die Datei zu steuern.
Gruß
Franz

Private Sub Workbook_Open()
Application.ScreenUpdating = False
Menü.Show 'vbModeless
Application.ScreenUpdating = True
Dim verfall As Date 'Zeile 11 ab hier soll bei richtiger Passworteingabe gelöscht werden
Dim passwort As String
Dim objName As Name
Call subRegistrierung
Set objName = Me.Names("xInfo")
If objName.RefersTo = "=""Nein""" Then
verfall = CDate("14.05.2018")
If verfall  "123" Then
MsgBox "     Die Registrierungsnummer ist ungültig," & Chr(13) & Chr(13) & _
"     das Programm wird geschlossen!"
ThisWorkbook.Close
Else
objName.RefersTo = "=""" & passwort & """"
Me.Save
End If
End If 'Zeile 25 bis hier soll gelöscht werden
End If
End Sub
Private Sub subRegistrierung()
Dim objName As Name
On Error Resume Next
Set objName = Me.Names("xInfo")
If objName Is Nothing Then
Set objName = Me.Names.Add("xInfo", "=""Nein""")
With objName
.Visible = False
End With
End If
End Sub
Private Sub subRegistrierungZuruecksetzen()
'Dieses Makro ausführen wenn die Datei fertig ist, vor dem Versand
Dim objName As Name
On Error Resume Next
Set objName = Me.Names("xInfo")
If objName Is Nothing Then
Set objName = Me.Names.Add("xInfo", "=""Nein""")
With objName
.Visible = False
End With
Else
objName.RefersTo = "=""Nein"""
End If
Me.Save
End Sub

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Verfallsdatum passwortgeschützt

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread