• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Terug tellende klok werkt niet in beveiligd blad

Status
Niet open voor verdere reacties.

CygneVoler

Gebruiker
Lid geworden
15 mei 2015
Berichten
234
Hoi Excellers,
Is het mogelijk om een timer (in mijn geval een terug tellende klok) te laten werken in een beveiligd blad?

De volgende code heb ik gebruikt: (Mod1)

Code:
Sub StartAftellen()
EndTime = Now + TimeValue("00:15:00")
NextTime = Now + TimeValue("00:00:00")
ActiveSheet.Range("N1").NumberFormat = "mm:ss"
ActiveSheet.Range("N1").Value = EndTime - Now
Application.OnTime NextTime, "VervolgAftellen"
End Sub

De code wordt actief nadat er een melding bij het openen van de file wordt getoond, dat het bestand na 15 minuten automatisch wordt afgesloten.

Ik heb al geprobeerd om de sheet te vervangen voor "activecel." Maar dat is denk ik te simpel gedacht.
De foutmelding komt alleen wanneer de file opnieuw wordt opgestart. Wanneer je de bladbeveiliging inschakelt tijdens het aftellen, dan blijft deze gewoon werken.

Ik kijk uit naar jullie reactie.

CooS
 
Laatst bewerkt:
ik denk dat je je bij cel N1 de celeigenschappen > bescherming "geblokkeerd" het vinkje moet uitzetten.
dan mag die cel wel gewijzigd worden. terwijl de sheet geblokkeerd wordt.
 
Bedankt voor je reactie #roeljongman, maar dat heb ik al gedaan. Ik wilde het bericht ook net iets aanpassen omdat, wanneer de timer "loopt" en je schakelt dan de bladbeveiliging aan, is er niets aan de hand. Echter wanneer je de file opstart, dan geeft hij een foutmelding.
 
De foutmelding is overigens "1004 tijdens uitvoering. Eigenschappen NumberFormat van klassieke range kan niet worden ingesteld."
 
en ik bedacht mij dat er inderdaad macros stoppen met runnen als een sheet protected is..
dus even verder gekeken.

je kunt een stukje code toevoegen die zorgt dat die bescherming alleen geldt voor de userinterface en niet de macro uitvoering

Code:
Sheet1.Protect Password:="abc" , UserInterFaceOnly:=True

sheet1 is het werkblad waar het op slaat.
password voeg je toe als je de bladbeveiling hebt ingesteld met een password.

linkje naar de lange versie van de uitleg (in het engels)... even scrollen naar het kopje UserInterfaseOnly
http://www.globaliconnect.com/excel...t-worksheetprotect-method&catid=79&Itemid=475
 
Werkt dit?
verander abc naar uw paswoord
Code:
Sub StartAftellen()
[COLOR="#FF0000"]Sheet1.Unprotect Password:="abc" [/COLOR]
EndTime = Now + TimeValue("00:15:00")
NextTime = Now + TimeValue("00:00:00")
ActiveSheet.Range("N1").NumberFormat = "mm:ss"
ActiveSheet.Range("N1").Value = EndTime - Now
Application.OnTime NextTime, "VervolgAftellen"
[COLOR="#FF0000"]Sheet1.Protect Password:="abc" [/COLOR]
End Sub
Edit:
Ook Sheet1 aanpassen
 
Laatst bewerkt:
Goedemorgen, het werkt deels. Want wanneer je de file opstart op "Sheet1" is er niet aan de hand, maar wanneer je bv op de beveiligde pagina van 4 of 5 bent geëindigd en de file wordt dan geopend, komt er ook een foutmelding. En de code "Sheets ("1, 4, 5").Unprotect Password:="abc", valt dan buiten het bereik. (het is wel op alle pagina's cel N1)
 
Laatst bewerkt:
Verwijder gewoon die celopmaak regel, of stel bij de bladbeveiliging in dat celopmaak mag worden aangepast. Zet verder het juiste werkblad voor de Range (hier even "Blad2"):

Code:
Sub StartAftellen()
EndTime = Now + TimeValue("00:15:00")
NextTime = Now + TimeValue("00:00:00")
[COLOR="#FF0000"]Worksheets("Blad2")[/COLOR].Range("N1").Value = EndTime - Now
Application.OnTime NextTime, "VervolgAftellen"
End Sub
 
Terugtellende klok:

Code:
Sub M_snb()
   With CreateObject("wscript.shell")
      For j = 5 To 1 Step -1
         .popup "nog " & j & " seconde" & IIf(j > 1, "n", ""), 1, "snb"
      Next
    End With
End Sub
 
#snb leuke tool, maar op deze manier ben ik er niet naar opzoek, sorry! #JKP het is idd zo dat het werkt op (in mijn geval) sheet11! Op blad 4 en 5 werkt deze nu niet! En dat zou wel mooi zijn! Heb je nog een truc uit de excel-trucen-doos? :d BTW, de locatie is in alle 3 gevalen N1!
 
Laatst bewerkt:
MOet ie op alle drie de tabs blijven tellen, of alleen op degene die je ziet?
 
bij voorkeur op alle drie de tabs! Hoewel het met een in de cel N1 verwijzing "=Sheet11!N1" ook prima verloopt momenteel! :eek:
 
Laatst bewerkt:
Is het mogelijk (en ook uitvoerbaar) om wanneer de file geopend wordt om dat dan altijd te laten uitvoeren vanaf het eerste sheet? (sheet11).
 
Ik heb momenteel een werkende file die aftelt, een melding aangeeft 5 sec voordat de file wordt afgesloten. De tabbladen 1,2 en 3 zijn voorzien van een bladbeveiliging en een link van blad 1 met de tijdswaarneming (aflopend).
De volgende codes heb ik daarvoor gebruikt.

In de mo***e

Code:
Option Explicit
Public NextTime As Date
Public EndTime As Date

Sub CloseWB()
    Application.DisplayAlerts = False
    With ThisWorkbook
        .Saved = True
        .Close
    End With
    End Sub

Sub Afsluiten()
  WarningMessage.Show
End Sub

Sub VervolgAftellen()
NextTime = Now + TimeValue("00:00:01")
Sheet11.Range("N2").Value = EndTime - Now
If EndTime - Now < 0 Then CloseWB 'Exit Sub
Application.OnTime NextTime, "VervolgAftellen"
End Sub


Sub StartAftellen()
Sheet11.Unprotect Password:="test"
NextTime = Now + TimeValue("00:00:00")
Sheet11.Range("N2").NumberFormat = "mm:ss"
Application.OnTime NextTime, "VervolgAftellen"
Sheet11.Protect Password:="test"
End Sub

WB

Code:
Private Sub Workbook_Open()
 With Sheets("ARTIKELEN")
   .Visible = True
   .Cells(1).CurrentRegion.Sort .Cells(1, 3), , , , , , , xlYes
   .Visible = xlVeryHidden
  End With
  EndTime = Now + TimeValue("00:10:50")
  Warningtime = EndTime - TimeValue("00:00:05")
  Application.ScreenUpdating = False
  Application.OnTime Warningtime, "Afsluiten", , True
  Application.OnTime EndTime, "CloseWB", , True
  AutoSluiten.Show
  StartAftellen
  Application.ScreenUpdating = True
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
For i = 6 To 6 'Sheets.Count
Sheets(i).Protect Password:="test"
Next
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If EndTime Then
        Application.OnTime _
        EarliestTime:=EndTime, _
        Procedure:="CloseWB", _
        Schedule:=False
        EndTime = Empty
    End If
End Sub

In het WB staan ook een aantal codes die geen betrekking hebben op het "aftellen" maar ik hoop dat jullie daar doorheen kunnen kijken.
Ik laat het nog een tijdje in test draaien, maar voorlopig gaat het goed.

Wederom bedankt voor jullie hulp en mocht je nog verbeterpunten zien, dan hoor ik deze graag.

Voor nu hartelijk dank.

CooS
 
Laatst bewerkt:
Het kwam toch nog voor dat de file weer opende nadat deze was afgeteld en afgesloten. Doordat ik onderstaande code heb uitgeschakeld bij het opstarten lijkt dit "geëlimineerd."

Code:
Application.OnTime EndTime, "CloseWB", , True

Is dit logisch? Of dom geluk?

Wel zie je aan de cursor dat er een tijd "loopt" doordat deze een soort van knipperen toont. Kan je dat ook stoppen?
 
Blijkbaar was dit een lastige case gezien de reacties. Ik zal het op een andere manier proberen uit te vinden. Zonnige dag verder!
 
Mbt bovenstaande heb ik een aanvullende vraag. Ik hoop dat iemand in de gelegenheid is om deze te beantwoorden.
Ik zou graag de aftellende klok willen laten stoppen. Met de volgende code wil dat helaas niet lukken. Heeft er iemand suggesties?

Ik heb een button

Code:
Private Sub CmbStop_Click()
STOPTIMER
End Sub

en in de module

Code:
Sub STOPTIMER()
Application.OnTime NextTime, "VervolgAftellen", False
End Sub

Alvast hartelijk dank voor jullie medewerking
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan