Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Timer

  • Timer von Norbert vom 27.09.2019 07:52:24


Betrifft: Timer von: Norbert
Geschrieben am: 27.09.2019 07:52:24

Hallo Spezialisten
ich habe eine Arbeitsmappe für einen Wissenstest von unseren Produkten vorbereitet.
Nun möchte ich gerne einen Timer einbauen, der z.B. nach einer Stunde die Datei automatisch speichert und dann schliesst. Vor dem Schliessen soll es aber noch ein verschlüsseltes Passwort setzten "wissen2019" sodass die Datei nur noch damit geöffnet werden lann.
Hat mir da jemand ein VBA script - oder ist das nicht möglich?
Danke im voraus für eine Lösung
Gruss Norbert

  

Betrifft: AW: Timer von: Oberschlumpf
Geschrieben am: 27.09.2019 08:04:37

Hi Norbert,

und wie geht es mit der Datei nach Passwort setzen + Speichern weiter?

1. Wirst dann nur noch du die Datei öffnen? (geht ja eigtl nicht anders, weil nur du das PW kennst :-) )
2. Weißt du, wie man das PW wieder entfernt, damit die Datei vom nächsten Probanden ohne PW geöffnet werden kann?

Ciao
Thorsten


  

Betrifft: AW: Timer von: Norbert
Geschrieben am: 27.09.2019 08:17:17

Hallo Thorsten
Ja, ich bin der Einzige der das dann öffnet - ich werte die Ergebnisse dann auch aus.
Der Test liegt nur auf einem neutralen Laptop und kann nur jeweils von einer Person bearbeitet werden.
Das Passwort möchte ich setzen, damit der Teilnehmer die Datei nicht nochmals öffnen und weiterarbeiten kann. Es sollen alle immer die gleiche Zeit zur Verfügung haben.
Gruss Norbert


  

Betrifft: AW: Timer von: Oberschlumpf
Geschrieben am: 27.09.2019 08:30:49

Hi Norbert,

ja, ich hab schon verstanden, was du erreichen möchtest:

Proband öffnet die Datei (ohne ein PW eingeben zu müssen)
Proband hat nun 1 Std Zeit, die Fragen zu beantworten
Datei erhält ein PW, wird automatisch gespeichert + geschlossen

Aber jetzt lässt sich die Datei nur noch - nach Eingabe des PW - öffnen
Was macht nun der nächste Proband? Der kann die Datei ja nicht mehr öffnen, weil sie PW-geschützt ist. <-- DAS ist meine Frage

Ciao
Thorsten


  

Betrifft: AW: Timer von: Norbert
Geschrieben am: 27.09.2019 08:54:35

Hallo Thorsten
für einen anderen Teilnehmer werde ich dann wieder eine neue ungeschütze Datei auf den Laptop laden, in der das Skript wieder drin ist.
Gruss Norbert


  

Betrifft: AW: Timer von: Oberschlumpf
Geschrieben am: 27.09.2019 09:02:55

Hi Norbert,

ok, hier eine Bsp-Datei für dich:
https://www.herber.de/bbs/user/132227.xlsm

Bitte speicher die Datei erst, bevor du sie öffnest!

Erklärung:
1. Öffnest du die Datei nun das erste Mal, wird sie einfach geöffnet
wegen des Tests wird die Datei schon nach 10 Sekunden mit dem PW "wissen2019" geschützt, automatisch gespeichert und wieder geschlossen

2. Öffnest du die Datei nun ein weiteres Mal, ist das zuvor gesetzte PW "wissen2019" erforderlich. Erst nach PW-Eingabe wird die Datei wieder...gespeichert + geschlossen.

Die Zeit von 10 Sekunden kanst du auf 1 Stunde verlängern, indem du im Workbook_Open-Ereignis diese Zeile

Application.OnTime Now + TimeValue("00:00:10"), "sbEnde"

änderst in
Application.OnTime Now + TimeValue("01:00:00"), "sbEnde"

Hilfts denn?

Ciao
Thorsten

P.S. zu bedenken ist vielleicht noch, dass jeder Proband innerhalb der 1 Std die Möglichkeit hat, die Datei unter anderen Namen zu speichern, die Datei vor Ablauf der Zeit zu schließen (mit/ohne speichern), die Datei zu speichern UND vorher selbst ein Passwort zu setzen


  

Betrifft: AW: Timer von: Norbert
Geschrieben am: 27.09.2019 09:28:48

Hallo Thorsten
Besten Dank - klappt perfekt.
Gruss Norbert


  

Betrifft: AW: Timer von: Pierre
Geschrieben am: 27.09.2019 10:01:57

Hallo Norbert,

arbeite doch mit einer Vorlage (.xltm)?
Dann hast du die leere Vorlage immer verfügbar, musst nichts löschen und so weiter.

Dann folgende Codes:
Unter "Diese Arbeitsmappe":

'einfügen in "Diese Arbeitsmappe"
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'Beim Speichern wird die Dateiendung vorgegeben und kann nicht
'mehr durch MA geändert werden.
'Es wird zusätzlich eine MessageBox geöffnet
Dim Datei As Variant

    ChDrive "C"                     'Laufwerk evtl. anpassen
    ChDir "C:\Users\user207\Desktop"




If SaveAsUI Then
    Cancel = True
    Do
        Datei = Application.GetSaveAsFilename
        If VarType(Datei) <> vbString Then Exit Do
        Datei = Left(Datei, InStrRev(Datei, ".")) & "xlsm"                  'Dateiendung evtl.  _
anpassen
        If Dir(Datei) <> "" Then
            Select Case MsgBox("Datei existiert schon, überschreiben?", _
                               vbQuestion + vbYesNoCancel)
                Case vbYes
                    Kill Datei
                    Me.SaveAs Datei, xlOpenXMLWorkbookMacroEnabled          'als .xlsm  _
speichern, evtl. anpassen
                    Exit Do
                Case vbNo
                Case vbCancel
                    Exit Do
            End Select
        Else
            Me.SaveAs Datei, xlOpenXMLWorkbookMacroEnabled                  'als .xlsm  _
speichern, evtl. anpassen
            Worksheets("Tabelle1").Unprotect Password:="XXX"                'Passwort anpassen
            Exit Do
        End If
    Loop
End If
       
End Sub
Unter einem allgemeinen Modul:
Sub Shutdown()

    ThisWorkbook.Close savechanges:=True

End Sub
Um einen Timer zu setzen, brauchst du folgende Codezeile unter "Diese Arbeitsmappe":
Application.OnTime Now + TimeValue("01:00:00"), "Shutdown"
ich weiß nur leider nicht, an welche Stelle die gehört, sorry.

Gruß Pierre


  

Betrifft: AW: Timer von: Pierre
Geschrieben am: 27.09.2019 10:08:06

Okay, habs kapiert :D

In einem Modul diesen Code:

Sub Shutdown()

Dim Datei As Variant
Dim SaveAsUI As Boolean
Dim Cancel As Boolean


    ChDrive "C"                     'Laufwerk evtl. anpassen
    ChDir "C:\Users\user207\Desktop"




If SaveAsUI Then
    Cancel = True
    Do
        Datei = Application.GetSaveAsFilename
        If VarType(Datei) <> vbString Then Exit Do
        Datei = Left(Datei, InStrRev(Datei, ".")) & "xlsm"                  'Dateiendung evtl.  _
anpassen
        If Dir(Datei) <> "" Then
            Select Case MsgBox("Datei existiert schon, überschreiben?", _
                               vbQuestion + vbYesNoCancel)
                Case vbYes
                    Kill Datei
                    Me.SaveAs Datei, xlOpenXMLWorkbookMacroEnabled          'als .xlsm  _
speichern, evtl. anpassen
                    Exit Do
                Case vbNo
                Case vbCancel
                    Exit Do
            End Select
        Else
            Me.SaveAs Datei, xlOpenXMLWorkbookMacroEnabled                  'als .xlsm  _
speichern, evtl. anpassen
            Worksheets("Tabelle1").Unprotect Password:="XXX"                'Passwort anpassen
            Exit Do
        End If
    Loop
End If
       
End Sub
Und unter "Diese Arbeitsmappe" dann diesen
Private Sub Worksheet_Open()
Application.OnTime Now + TimeValue("01:00:00"), "Shutdown"

End Sub
Sorry dafür.