Speichern VBA über InputBox
26.05.2021 12:24:52
Tomek
ich habe ein Problem bei dem ich einfach nicht weiterkomme und leider auch mithilfe von Suchmaschinen ob im Forum oder bei dem großen "G" weiterkomme.
Vielleicht könnt ihr mir helfen.
Ich habe eine eigentlich simple Datei über welche ich wöchentlich die Werte in eine andere Zelle verschiebe.
Das klappt auch soweit.
Da das ganze auch in Fremdnutzung ist und ich mir nur äußerst ungern immer wieder meine Dateien von den netten Kollegen "zerlegen" lassen möchte habe ich das workbook generell mit einem speicherungsverbot versehen, welches durch das richtige Kennwort natürlich umgangen werden kann.
Code hierzu:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
' Verbietet speichern für den User, Ausnahme korrektes pw.
Dim strpw As String
strpw = Application.InputBox("Diese Datei darf nicht gespeichert werden !!!", "Speichern abgebrochen")
If strpw = "" Or strpw "test" Then
Cancel = True
Exit Sub
End If
End Sub
Und hier ist das Problem an welchem ich verzweifle.
Die Passwortabfrage des Workbooks arbeitet nämlich mit einer InputBox in welche vom User das Passwort eingetragen wird.
Das Makro aus dem Modul scheitert jedoch weil es ja beim workbook.save die Inputbox aus dem Workbook Makro läd und diese nicht gefüllt bekommt.
Ich habe es hier mit dem Command
WriteResPassword
Und der Code vom Modul:
Sub Tausch()
' Tausch Makro
Dim FirstDate As Date ' Declare variables.
FirstDate = InputBox("Für welches Datum soll der Plan generiert werden? Achtung, um die Richtige Reihenfolge sicherzustellen immer nur um eine Woche erhöhen. Keine Sprünge!!!")
' verschiebt den Plan jeweils +1ne Woche Aufsteigend
' setzt das gewünschte Datum ein
' speichert die Datei auf den neuen Wert um beim nächsten Aufruf an der richtigen Stelle zu beginnen
Range("E17").Select
Selection.ClearContents
Range("E19:E21").Select
Selection.Copy
Range("E17").Select
ActiveSheet.Paste
Range("E6").Select
Selection.Copy
Range("E21").Select
ActiveSheet.Paste
Range("E17:E21").Select
Application.CutCopyMode = False
Selection.Copy
Range("E6").Select
ActiveSheet.Paste
Range("I1") = FirstDate
Range("A1").Select
Application.CutCopyMode = False
ActiveWorkbook.save ' , WriteResPassword:=test
End Sub
Habe mal die komplette Datei hochgeladen, vielleicht versuche ich auch mein Ziel wieder mal viel zu umständlich zu erreichen so das das alles gar nicht notwendig wäre!?! Allerdings ist das wohl das Los der Anfänger auf dem Gebiet. Darum habe ich auch direkt mal hochgeladen.
https://www.herber.de/bbs/user/146384.xlsm
Bin über jegliche Hilfe dankbar.
VG
Tomek