Sicherung mit Passwort belegen
chris58
Ich habe diesen Code mithilfe eines Users zusammengestopelt, jedoch möchte ich, das, wenn das Tabellenblatt gesichert wird, dieses mit einem Passwort belegt wird, damit man es nicht mehr ändern kann. Ich habe keinen Schimmer, was ich einfügen könnte, um dies zu erreichen.
Kann mir bitte ein user helfen.
Danke
chris
Public Sub MappeFestwerteSpeichern()
Dim wsTab As Worksheet
Dim objShape As Shape
Dim lngZähler As Long
Dim lngArray() As Long
Dim strName As String
' Name der aktiven Mappe in Textvariable schreiben
strName = ActiveWorkbook.Name
' den linken Teil des Namens vor dem Punkt in Variable schreiben
strName = Left(strName, InStr(strName, ".") - 1)
' Matrix auf die Zahl der worhandenen Arbetisblätter der Mappe erweitern
ReDim lngArray(1 To Worksheets.Count)
' In einer Schleife die die Matrix mit dem Index der Arbeitsblätter füllen
For lngZähler = 1 To Worksheets.Count
lngArray(lngZähler) = lngZähler
Next lngZähler
' Die per Matrix ermittleten Arbeitsblätter in eine neue Tabelle kopieren
ActiveWorkbook.Worksheets(lngArray).Copy
' In der neuen Mappe in den Arbeitsblättern den genutzten Bereich mit dem Werten befüllten
For Each wsTab In ActiveWorkbook.Worksheets
With wsTab.UsedRange
.Value = .Value
End With
For Each objShape In wsTab.Shapes
If objShape.Type = msoFormControl Then objShape.Delete
Next
Next wsTab
' Zusammensetzen des Namens aus Zellen
strName = strName & " " & Range("A50").Text & " " & Range("A5").Text & " " & Range("B5"). _
Text
' Speichern und schliessen der aktiven Mappe
ActiveWorkbook.Close SaveChanges:=True, _
Filename:="C:\Dokumente und Einstellungen\arch\Desktop\Sommer 2012\Dienstpläne\Monatskopien\" & _
strName
End Sub