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

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.

[b]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
[/b]

Kopiere das Makro in ein Klassenmodul und vergebe der Klasse den Namen "clsWandlText".

[b]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
[/b]

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.}

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