ich habe ein Makro für das erstellen einer Datei aus dem Forum etc. mir zusammengestellt.
Ich füge mein VBA Passwortschutz ein, klappt erstaunlicherweise auch.
Nun möchte ich zum Abschluss die Datei schließen geht nicht, Warum ?
Hier mein Makro:
Sub BlattSpeichern()
Dim TBName$, WBName$
Dim tan
tan = ActiveSheet.Name
TBName = InputBox("Blattname:", "Datei erstellen", tan)
If TBName = "" Then Exit Sub
WBName = InputBox("Dateiname übernehmen oder ändern ?", _
"Dateinamen erstellen", tan & " vom " & Format(Date, "YYYY.MM.DD") & ".xls")
If WBName = "" Then Exit Sub
Worksheets(TBName).Copy
'--- so jetzt noch ins Verzeichnis speichern -------------
Dim Fs As Object, OrdNam As Variant, Ord As Byte, Pfad As String
Dim DateiNam As String
DateiNam = WBName
On Error Resume Next
OrdNam = Split("C:\Werkstatt\Muster\Teile", "\")
Pfad = OrdNam(0) & "\"
ChDrive Left(OrdNam(0), 1)
For Ord = 1 To UBound(OrdNam)
ChDir Pfad
Set Fs = CreateObject("Scripting.FileSystemObject")
If Not Fs.folderexists(Pfad & OrdNam(Ord)) Then
MkDir OrdNam(Ord)
MsgBox "Der Ordner " & vbLf & vbLf & Pfad & OrdNam(Ord) & _
vbLf & vbLf & " wurde erstellt. "
Else
' MsgBox "Der Ordner " & vbLf & vbLf & Pfad & _
' OrdNam(Ord) & vbLf & vbLf & " existiert bereits. "
End If
Pfad = Pfad & OrdNam(Ord) & "\"
Next Ord
Set Fs = Nothing
MsgBox "Ordner: " & Pfad & " ist vorhanden ! " & Chr(13) _
& Chr(13) & " Datei: " & " " & DateiNam & " " _
& " wird jetzt gespeichert ! ", vbInformation, " Hinweis !"
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=Pfad & DateiNam, FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False
'----- jetzt schutz setzen --------------
Dim akw As String
akw = ActiveWorkbook.Name
Dim Password As String
Password = "wwpawb"
Dim wb As Workbook, ok As Boolean, s As String
Set wb = Application.Workbooks(akw)
SendKeys "%{F11}^r{Tab}", True
Do While Application.VBE.ActiveVBProject.Filename wb.FullName
''Cursor im Projekt-Explorer-Fenster auf das nächste Projekt setzen _
bis er auf dem aktuelle Projekt der zu entschützenden Arbeitsmappe steht
SendKeys "{Tab}", True
Loop
If Not ActiveWorkbook.VBProject.Protection Then
' Application.DisplayAlerts = False
' Application.ScreenUpdating = False
SendKeys "%xi" 'damit Passwort
SendKeys "{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}{TAB}"
SendKeys "{RIGHT}"
SendKeys "{TAB}"
SendKeys " " 'für Leertaste
SendKeys "{TAB}"
SendKeys Password
SendKeys "{TAB}"
SendKeys Password
SendKeys "{TAB}"
SendKeys "{Enter}"
SendKeys "%{F11}"
End If
' MsgBox "Der VBA Schutz ist eingefügt ! "
'ActiveWorkbook.Close
End Sub
mfg Kurt P