I have the following code for executing a macro on opening a workbook, until the time to executing it comes (until a maximum time limit):
Private Sub Workbook_Open()
Dim time_executing_macro As Date
Dim maximum_time_to_launch_macro As Date
time_executing_macro = "17:00:00"
maximum_time_to_launch_macro = "19:00:00"
Do
If (Now() >= time_executing_macro) Then
MsgBox ("OK")
Exit Sub
End If
Loop Until (Now() >= maximum_time_to_launch_macro)
End Sub
The problem is that, as of today at 12:21, the code keeps launching the MsgBox. As far as I know 12:21:00 < 17:00:00, so what am I doing wrong?
Thanks in advance.
Related
I'm trying to create a countdown in Visual Basic for my PowerPoint presentation. This worked absolutely fine. I need the macro to start when The slide changes. The slide has to change after 20 seconds. This also works. But when I change the slide programmatically the method OnSlideShowChangedPage doesn't run. Does anyone have an idea why it doesn't work?
This is my code:
Sub OnSlideShowPageChange(ByVal Wn As SlideShowWindow)
MsgBox "Fired"
Dim pos As Integer
pos = Wn.View.CurrentShowPosition
Dim time As Date
time = Now()
Dim count As Integer
count = 20
time = DateAdd("s", count, time)
Do Until time < Now()
DoEvents
ActivePresentation.Slides(pos).Shapes("countdown").TextFrame.TextRange = Format((time - Now()), "hh:mm:ss")
Loop
ActivePresentation.SlideShowWindow.View.Next
End Sub
I am trying to create a countdown timer in word.
While running the code i am getting "Runtime error '70': permission denied" for a line in the code: time = time + TimeValue("00:00:01") in modtimer module.
I have created a userform and a separate module named modtimer, the code is given below:
The word document code: (ThisDocument) to show timer when word document opens
Sub Document_Open()
UserForm1.time_left.Visible = False
UserForm1.Label1.Visible = False
UserForm1.Show
End Sub
The code given in userform is as follows:
Dim g_start As Variant
Dim start As Variant
Dim timeEnd As Variant
Dim g_time As Variant
Dim time As Variant
Dim g_timeEnd As Variant
Dim time_duration As Variant
Dim g_time_duration As Variant
Dim g_End As Boolean
Private Sub btnStart_Click()
start = Now
g_start = Format(start, "hh:mm:ss")
timeEnd = Now + TimeValue("00:30:00")
g_timeEnd = Format(timeEnd, "hh:mm:ss")
time_duration = timeEnd - start
g_time_duration = Format(time_duration, "hh:mm:ss")
Label1.Visible = True
time_left.Caption = g_time_duration
time_left.Visible = True
btnStart.Visible = False
time = start + TimeValue("00:00:01")
time_duration = timeEnd - time
g_time_duration = Format(time_duration, "hh:mm:ss")
time_left.Caption = g_time_duration
modtimer.time_count
End Sub
The module code is as follows:
Sub time_count()
If time_duration = TimeValue("00:05:00") Then
MsgBox "Only 5 minutes remaining", vbInformation
End If
time = time + TimeValue("00:00:01")
time_duration = timeEnd - time
If time_duration = TimeValue("00:00:00") Then
g_End = True
End_Exam
End If
'If g_End = True Then
' End_Exam
'End If
g_time_duration = Format(time_duration, "hh:mm:ss")
time_left.Caption = g_time_duration
Call time_count
End Sub
Sub End_Exam()
MsgBox "Examination Time has Expired, Click Ok to Submit", vbCritical
'Documents.Save False, wdOriginalDocumentFormat
Documents.Close wdPromptToSaveChanges, wdPromptUser
End Sub
What is the reason behind it? Can anybody help?
Time is a vba function (and also a vba statement btw).
It is not a good idea to define a variable with the same name.
In your userform, you are overloading the function with your variable, but in the module every time you use Time your are referring to the standard Function (or statement), not the variable from the userform.
By the way, variables in userforms are private by default, so you cannot access the time variable in the userform from the module, you need to specify Public instead of Dim.
Once the variable is Public, you will be able to access it but you will need to use Userform1.time instead of only time.
But it still isn't a good idea to name it time
Additional explanation:
In the module, in the line
time = time + TimeValue("00:00:01")
The first time is the time statement (to change system time)
The second time is the time function (returns current time)
So you are trying to set the system time to the current time + 1 second.
This operation can be done only if you have elevated rights, hence the Runtime error '70': permission denied you get.
Time is an VBA property, and it is read-only (it gives simple the actual time). If you need a variable, use a different name.
I'm trying to come up with a way to close an excel document after a period of inactivity. The problem i'm running into is that if excel is in Edit mode, the macro will not execute. This would be for a workbook that is on a server that multiple people have access to, the problem is that some people leave it open and forget that they have it open and no one else can edit it hence the need for this.
I've create a VBA macro code that only closes the excel document while the user is not in edit mode:
Sub OpenUp()
Dim Start, Finish, TotalTime, TotalTimeInMinutes, TimeInMinutes
Application.DisplayAlerts = True
TimeInMinutes = 1 ' sets timer for 1 minutes
If TimeInMinutes > 1 Then
TotalTimeInMinutes = (TimeInMinutes * 60) - (1 * 60)
' times 60 seconds to "minutize"/convert time from seconds to minutes
Start = Timer ' Sets the start time.
Do While Timer < Start + TotalTimeInMinutes
DoEvents ' Yield to other Excel processes.
Loop
Finish = Timer ' Set end time.
TotalTime = Finish - Start ' Calculate total time.
Application.DisplayAlerts = False
MsgBox "You've had this file open for " & TotalTime / 60 & " minutes. You have 1 minute to save all your files before Excel closes"
End If
Start = Timer ' Sets the start time.
Do While Timer < Start + (1 * 60)
DoEvents ' Yield to other Excel processes.
Loop
Finish = Timer ' Set end time.
TotalTime = Finish - Start ' Calculate total time.
Application.DisplayAlerts = False
ThisWorkbook.Save
Application.Quit
End Sub
I know this request kind of defies logic as you don't want the workbook to close while someone is in the middle of a edit hence why you can't run a macro while in edit mode. But if there is any way to set up some code to save and close a workbook after a certain set time period has passed i would have need of it in this circumstance. Thanks
You need place the below code and save the file to XLSM type. Reopen the file to run the macro
Place the code in the standard module
Option Explicit
Public EndTime
Sub RunTime()
Application.OnTime _
EarliestTime:=EndTime, _
Procedure:="CloseWB", _
Schedule:=True
End Sub
Sub CloseWB()
Application.DisplayAlerts = False
With ThisWorkbook
.Save
.Close
End With
End Sub
Place the code in the Thisworkbook Module
Option Explicit
Private Sub Workbook_Open()
EndTime = Now + TimeValue("00:00:20") '~~> 20 Seconds
RunTime
End Sub
Place this in each worksheet to detect any changes in the worksheet
Private Sub Worksheet_Change(ByVal Target As Range)
If EndTime Then
Application.OnTime _
EarliestTime:=EndTime, _
Procedure:="CloseWB", _
Schedule:=False
EndTime = Empty
End If
EndTime = Now + TimeValue("00:00:20") '~~> 20 Seconds
RunTime
End Sub
I have got the answer from this site
http://www.excelforum.com/excel-programming-vba-macros/600241-excel-vba-close-workbook-after-inactivity.html
avid reader, first time poster here. I have a Macro that I obtained from the internet for the most part, then made some adjustments. It's purpose is to color code cells that have passed a certain duration. It was working fine earlier, but now I am getting an error on it for a "Type Mismatch". The line that reads "This is where the error is" is where I am getting the mismatch. I am puzzled because it was working fine earlier. I am not a seasoned programmer by any means, but I just try to troubleshoot things. I have looked all over the net and cant find a specific answer to my question.
In addition, if any of you are willing, I would appreciate your advice on how to make this code run ONLY at startup of the workbook and NOT periodically as it is set up to do so now.This code is not placed in a worksheet, but in a Module.I mention this because I am not sure how much of a practical difference it can make any help is appreciated, thanks!
Public TimeToRun As Date
Sub Auto_Open()
Call ScheduleCompareTime
End Sub
Sub ScheduleCompareTime()
TimeToRun = Now + TimeValue("00:00:10")
Application.OnTime TimeToRun, "CompareTimeStamp"
End Sub
Sub CompareTimeStamp()
Dim rgTimeStamp As Range
Dim rdTimeStamp As Range
Dim i As Long
Dim j As Long
Dim MyNow As Date
Dim TimeStamp As Date, TimeStampp As Date
Set rgTimeStamp = Range("c1:c500")
Set rdTimeStamp = Range("H1:h500")
For i = 1 To rgTimeStamp.Rows.Count
If Not rgTimeStamp.Cells(i, 1) < 1 Then 'don't run for an empty cell
MyNow = CDate(Now - TimeSerial(0, 0, 0)) 'time instantly
TimeStamp = CDate(rgTimeStamp.Cells(i, 1)) 'THIS IS WHERE THE ERROR IS!!
If TimeStamp < MyNow Then 'if it's old at all
rgTimeStamp.Cells(i, 1).Interior.ColorIndex = 3 'make fill colour red
End If
End If
Next
For j = 1 To rdTimeStamp.Rows.Count
If Not rdTimeStamp.Cells(j, 1) < 1 Then
MyNow = CDate(Now - TimeSerial(0, 0, 0))
TimeStampp = CDate(rdTimeStamp.Cells(j, 1))
If TimeStampp < MyNow Then
rdTimeStamp.Cells(j, 1).Interior.ColorIndex = 3
End If
End If 'closes If Not
Next
Call ScheduleCompareTime 'begins the scheduler again
End Sub
Sub auto_close() 'turn the scheduler off so you can close workbook
Application.OnTime TimeToRun, "CompareTimeStamp", , False
End Sub
You probably have data in one or more cells that Excel cannot convert to a date. You can get around this by adding some simple checking such as this:
'.... beginning of your code
If Not rgTimeStamp.Cells(i, 1) < 1 Then 'don't run for an empty cell
MyNow = CDate(Now - TimeSerial(0, 0, 0)) 'time instantly
If IsDate(rgTimeStamp.Cells(i, 1)) = False Then
MsgBox "Invalid date found in cell " & rgTimeStamp.Cells(i, 1).Address(False, False)
Exit Sub
End If
TimeStamp = CDate(rgTimeStamp.Cells(i, 1)) 'THIS IS WHERE THE ERROR IS!!
If TimeStamp < MyNow Then 'if it's old at all
rgTimeStamp.Cells(i, 1).Interior.ColorIndex = 3 'make fill colour red
End If
End If
'... rest of your code
If you only want the code to run at startup then change Sub Auto_Open to this:
Sub Auto_Open()
Call CompareTimeStamp
End Sub
I have some code here that works perfectly except for when I try to close the Excel Sheet. I have tried to program the timer to stop when i close the Workbook but it does not seem to be working. Whenever I close the workbook it automatically re-opens. Any help with tweaking my code would be gratly appreciated. Here it is:
Code in Module 1:
Dim RT1 As Date
Dim Lunch As Date
Dim ApT As Date
Dim RT3 As Date
Dim NextTick As Date
Public Sub UpdateTime()
' Places a bug fix for stopping the clock when closing the workbook
Debug.Print "UpdateTime" & Format(RunWhen, "00:00:00")
' Updates cell D8 with the Current time
ThisWorkbook.Sheets(1).Range("D8") = Now()
' Set up next event 1 second from now
NextTick = Now + TimeValue("00:00:01")
Application.OnTime NextTick, "UpdateTime"
End Sub
Public Sub StopClock()
' Cancels the OnTime event
On Error Resume Next
Application.OnTime NextTick, "UpdateTime", , False
End Sub
Code in Module 2:
Sub PhoneHours()
'Time left at the beginning of the day
If Range("B12") < Range("A3") Then Range("E12").FormulaR1C1 = "=(R[3]C[-3]-R[0]C[-3])- (2*R[0]C[1])"
'Time left after the first Research Time Has passed
If Range("B12") >= Range("A3") Then Range("E12").FormulaR1C1 = "=(R[3]C[-3]-R[0]C[-3])- (1.75*R[0]C[1])"
'Time left after Lunch and Second Research Time
If Range("B12") >= Range("B3") Then Range("E12").FormulaR1C1 = "=(R[3]C[-3]-R[0]C[-3])- (0.5*R[0]C[1])"
'Time left afetr Apple Time
If Range("B12") >= Range("D3") Then Range("E12").FormulaR1C1 = "=(R[3]C[-3]-R[0]C[-3])- (0.25*R[0]C[1])"
'Time left after Final Research Time
If Range("B12") >= Range("E3") Then Range("E12").FormulaR1C1 = "=(R[3]C[-3]-R[0]C[-3])"
NextCheck = Now + TimeValue("00:00:10")
Application.OnTime NextCheck, "PhoneHours"
End Sub
Sub StopCheck()
' Cancels the OnTime event
On Error Resume Next
Application.OnTime NextCheck, "PhoneHours", , False
End Sub
Code in ThisWorkbook:
Sub Worksheet_Deactivate()
Call StopClock
Call StopCheck
End Sub
Sub Workbook_Activate()
Call UpdateTime
Call PhoneHours
End Sub
Sub Workbook_Open()
Call UpdateTime
Call PhoneHours
End Sub
Sub Workbook_Close()
Call StopClock
Call StopCheck
End Sub
Thanks in Advance!
When I tried do something similar I found that the main problem was that OnTime calls were being raised far more frequently than I expected - if you put a debug.print in your PhoneHours sub then you'll see that this is the case here. Your StopCheck routine is only cancelling the latest call, but all earlier ones are still active (and are causing the book to be reopened after closing).
You may want to create some breakpoints/debugs to find out exactly where and why each one is being called in order to make your sheet run more efficiently, but in any case I found that the most reliable way of cancelling all future ontime calls was a bit of a scattergun approach as follows:
Sub StopCheck()
' Cancels the OnTime event
Debug.Print "Cancelled Phonehours"
On Error Resume Next
' Cancels all OnTime events scheduled in the next 15 seconds
For i = 0 To 15
Application.OnTime Now + TimeValue("00:00:" & i), "PhoneHours", , False
Next i
On Error GoTo 0
End Sub
and
Public Sub StopClock()
' Cancels the OnTime event
On Error Resume Next
Debug.Print "Cancelled UpdateTime"
' Cancels all OnTime events scheduled in the next 3 seconds
For i = 0 To 3
Application.OnTime Now + TimeValue("00:00:" & i), "UpdateTime", , False
Next i
On Error GoTo 0
End Sub
This should leave no remaining future OnTimes scheduled and you should be able to close your sheet successfully.
(Incidentally, should your Worksheet_Deactivate be a Workbook_Deactivate?)