Supportnet / Forum / WindowsXP
Excel Arbeitsblätter mit Makro schützen
Frage
Hallo!
Ich habe ein makro um Arbeitsblätter zu schützen.
Ist es möglich das Passwort unsichtbar zu machen?
hier das Makro
Sub SchutzHin()
Dim x As Integer
If InputBox("bitte Passwort eingeben") = "schutz" Then
For x = 1 To Worksheets.Count
Worksheets(x).Protect password = "schutz"
Next x
Else: Exit Sub
End If
End Sub
Sub SchutzWeg()
Dim x As Integer
If InputBox("bitte Passwort eingeben") = "schutz" Then
For x = 1 To Worksheets.Count
Worksheets(x).Unprotect Passwort = "schutz"
Next x
Else: Exit Sub
End If
End Sub
Können Sie mir Helfen
Gruß heinz
Antwort 1 von KJG17
Hallo Heinz,
reicht dir dir der normale Excel-Passwortschutz nicht?
Datei / Speichern unter / Extras / Allgemeine Optionen...
dort Lese-/Schreib-Kennwort und/oder Schreibkennwort festlegen.
Wenn du beide Felder mit unterschiedlichen Passwörten versiehts, muss man sogar zum Öffnen das eine und zum Bearbeiten dann auch noch das andere eingeben.
Gruß
Kalle
reicht dir dir der normale Excel-Passwortschutz nicht?
Datei / Speichern unter / Extras / Allgemeine Optionen...
dort Lese-/Schreib-Kennwort und/oder Schreibkennwort festlegen.
Wenn du beide Felder mit unterschiedlichen Passwörten versiehts, muss man sogar zum Öffnen das eine und zum Bearbeiten dann auch noch das andere eingeben.
Gruß
Kalle
Antwort 2 von coros
Hallo Heinz,
das Passowrt unsichtbar machen ist nicht so einfach möglich. Du könntest es z.B. 64bit verschlüsseln. Dann würde dort nicht das Wort "schutz", sondern ein Wirrwarr an Zeichen stehen, die Du bei Deiner Abfrage wieder entschlüsseln müstest.
Nachfolgend mal die Funktionen zum Ver- und Entschlüsseln der Wörter und dieses dann in Dein Makro eingebaut.
Kopiere das Makro in ein StandardModul
Teste das Makro aber bitte in einer Testdatei und nicht gleich in Deiner Originaldatei.
Kopiere das Makro in ein Klassenmodul und vergebe der Klasse den Namen "clsWandlText".
Ich habe Dir mal eine Beispieldatei erstellt, damit Du Dir das mal in der Exceldatei ansehen kannst. Lade Dir die Datei mal unter http://www.excelbeispiele.de/Beispiele_Supportnet/Beispiel_Heinz.xls
herunter und schau Dir das an. Bei Fragen melde Dich.
MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du
ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.
das Passowrt unsichtbar machen ist nicht so einfach möglich. Du könntest es z.B. 64bit verschlüsseln. Dann würde dort nicht das Wort "schutz", sondern ein Wirrwarr an Zeichen stehen, die Du bei Deiner Abfrage wieder entschlüsseln müstest.
Nachfolgend mal die Funktionen zum Ver- und Entschlüsseln der Wörter und dieses dann in Dein Makro eingebaut.
Kopiere das Makro in ein StandardModul
Teste das Makro aber bitte in einer Testdatei und nicht gleich in Deiner Originaldatei.
Option Explicit
Option Private Module
Global Crypt As Boolean
Function Verschl(eText As String, eKey As String) As String
Dim cipherTest As New clsWandlText
cipherTest.KeyString = eKey
cipherTest.Text = eText
cipherTest.CryptMitXOR
cipherTest.Stretch
Verschl = cipherTest.Text
End Function
Function Entschl(dText As String, dKey As String) As String
Dim cipherTest As New clsWandlText
cipherTest.KeyString = dKey
cipherTest.Text = dText
cipherTest.DoCd
cipherTest.CryptMitXOR
Entschl = cipherTest.Text
End Function
Sub SchutzHin()
Dim x As Integer
If InputBox("bitte Passwort eingeben") = Entschl("`tmxWCFi", "") Then
For x = 1 To Worksheets.Count
Worksheets(x).Protect Password:=Entschl("`tmxWCFi", "")
Next x
Else: Exit Sub
End If
End Sub
Sub SchutzWeg()
Dim x As Integer
If InputBox("bitte Passwort eingeben") = Entschl("`tmxWCFi", "") Then
For x = 1 To Worksheets.Count
Worksheets(x).Unprotect Password:=Entschl("`tmxWCFi", "")
Next x
Else: Exit Sub
End If
End Sub
Kopiere das Makro in ein Klassenmodul und vergebe der Klasse den Namen "clsWandlText".
Option Explicit
Private mstrKey As String
Private mstrText As String
Public Property Let KeyString(strKey As String)
mstrKey = strKey
Initialize
End Property
Public Property Let Text(strText As String)
mstrText = strText
End Property
Public Property Get Text() As String
Text = mstrText
End Property
Public Sub CryptMitXOR()
Dim lngC As Long
Dim intB As Long
Dim lngN As Long
On Error Resume Next
For lngN = 1 To Len(mstrText)
lngC = Asc(Mid(mstrText, lngN, 1))
intB = Int(Rnd * 256)
Mid(mstrText, lngN, 1) = Chr(lngC Xor intB)
Next lngN
End Sub
Public Sub Stretch()
Dim lngC As Long
Dim lngN As Long
Dim lngJ As Long
Dim lngK As Long
Dim lngA As Long
Dim strB As String
On Error Resume Next
lngA = Len(mstrText)
strB = Space(lngA + (lngA + 2) \ 3)
For lngN = 1 To lngA
lngC = Asc(Mid(mstrText, lngN, 1))
lngJ = lngJ + 1
Mid(strB, lngJ, 1) = Chr((lngC And 63) + 59)
Select Case lngN Mod 3
Case 1
lngK = lngK Or ((lngC \ 64) * 16)
Case 2
lngK = lngK Or ((lngC \ 64) * 4)
Case 0
lngK = lngK Or (lngC \ 64)
lngJ = lngJ + 1
Mid(strB, lngJ, 1) = Chr(lngK + 59)
lngK = 0
End Select
Next lngN
If lngA Mod 3 Then
lngJ = lngJ + 1
Mid(strB, lngJ, 1) = Chr(lngK + 59)
End If
mstrText = strB
End Sub
Public Sub DoCd()
Dim lngC As Long
Dim lngD As Long
Dim lngE As Long
Dim lngA As Long
Dim lngB As Long
Dim lngN As Long
Dim lngJ As Long
Dim lngK As Long
Dim strB As String
On Error Resume Next
lngA = Len(mstrText)
lngB = lngA - 1 - (lngA - 1) \ 4
strB = Space(lngB)
For lngN = 1 To lngB
lngJ = lngJ + 1
lngC = Asc(Mid(mstrText, lngJ, 1)) - 59
Select Case lngN Mod 3
Case 1
lngK = lngK + 4
If lngK > lngA Then lngK = lngA
lngE = Asc(Mid(mstrText, lngK, 1)) - 59
lngD = ((lngE \ 16) And 3) * 64
Case 2
lngD = ((lngE \ 4) And 3) * 64
Case 0
lngD = (lngE And 3) * 64
lngJ = lngJ + 1
End Select
Mid(strB, lngN, 1) = Chr(lngC Or lngD)
Next lngN
mstrText = strB
End Sub
Private Sub Initialize()
Dim lngN As Long
Randomize Rnd(-1)
For lngN = 1 To Len(mstrKey)
Randomize Rnd(-Rnd * Asc(Mid(mstrKey, lngN, 1)))
Next lngN
End Sub
Ich habe Dir mal eine Beispieldatei erstellt, damit Du Dir das mal in der Exceldatei ansehen kannst. Lade Dir die Datei mal unter http://www.excelbeispiele.de/Beispiele_Supportnet/Beispiel_Heinz.xls
herunter und schau Dir das an. Bei Fragen melde Dich.
MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du
ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.
Antwort 3 von xxxx
Hallo!
Ich bins noch mal , habe mich wohl nicht richtig ausgedrückt.
wenn ich das passwort schutz eingebe sollte nicht der name lesbar sein sondern sterne erscheinen ist das möglich.
habe die frage unter der nummer 1687842 gestellt.
gruß
heinz
Ich bins noch mal , habe mich wohl nicht richtig ausgedrückt.
wenn ich das passwort schutz eingebe sollte nicht der name lesbar sein sondern sterne erscheinen ist das möglich.
habe die frage unter der nummer 1687842 gestellt.
gruß
heinz