ich hoffe ihr könnt mir helfen.
Ich möchte mehrere Tabellen auf einmal mit einem Passwort versehen.
Wie kann man ein Passwort auf ca. 10 bis 20 Tabellen in einem Rutsch
anwenden.
Gibt es dafür eine VBA - Lösung ?
Im voraus Danke
Gruß Manni
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim fs
Set fs = CreateObject("Scripting.FileSystemObject")
Dim AktFile
Dim NewPassword
Dim OldPassword
NewPassword = Modul1.GetNewPassword
OldPassword = Modul1.GetOldPassword
With Application.FileSearch
For i = 2 To .FoundFiles.Count
AktFile = .FoundFiles(i)
Label3.Caption = "Datei " & i & " von " & .FoundFiles.Count
Label4.Caption = AktFile
Application.ScreenUpdating = True
Form1.Repaint
Application.ScreenUpdating = False
'AktFile öffnen
Workbooks.Open Filename:=AktFile, Password:=OldPassword
'Aktfile speichern unter Temp
ActiveWorkbook.SaveAs Filename:="C:\Temp112.DOC", _
FileFormat:=xlNormal, Password:=NewPassword, WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=True
ActiveWindow.Close
'Temp öffnen
Workbooks.Open Filename:="C:\Temp112.DOC", Password:=NewPassword
'AktFile löschen
fs.DeleteFile (AktFile)
ActiveWorkbook.SaveAs Filename:=AktFile, _
FileFormat:=xlNormal, Password:=NewPassword, WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=True
ActiveWindow.Close
fs.DeleteFile ("C:\Temp112.DOC")
Next i
End With
Application.ScreenUpdating = True
Form1.Hide
MsgBox "Passwortänderung abgeschlossen"
End Sub
Private Sub CommandButton2_Click()
Form1.Hide
End Sub
Private Sub UserForm_Click()
End Sub
Sub Blattschutz_ein()
Dim WS as Worksheet
For Each WS in Worksheets
WS.Protect "Dein_Passwort"
Next
End Sub
Sub Blattschutz_aus()
Dim WS as Worksheet
For Each WS in Worksheets
WS.Unprotect "Dein_Passwort"
Next
End Sub