I have a small scrip that basically presses "F2" for me every 4 minutes for the duration of 8hours for the active application.
It works and is really basic as my skills in VB are extremely limited.
I now thought of a new addition to the project but have no idea if it is possible or how to tackle it.
I would basically like to have a small window in which the timer is displayed as well as a Pause and Resume and Stop button. It would be of a huge advantage if I could have these buttons as if I´m in another application, i don´t want the F2 button pressed.
Here is what I have:
Dim WshShell
Set WshShell = CreateObject("WScript.Shell")
dim ti
ti=timer
Do
WshShell.SendKeys "{F2}"
For AA = 1 To 9
IF AA = 8 Then BB = "in 30 seconds"
IF AA = 9 Then BB = "now !"
WScript.Sleep 30000
Dim oShell
Set oShell= CreateObject("Wscript.Shell")
IF AA = 8 OR AA = 9 Then oShell.Popup " Refresh ... " & BB & " ",2,"Remind"
Next
Loop while (timer-ti)<8*60*60
MsgBox "VB End: " & Time()
Thank you
OK, just a high level answer as it's late and I'm going to bed.
On your form, place a timer control. Set it for a 1000 interval (1 sec).
Place your start & pause buttons also.
Here's the code that will run it.
Dim IsRunning As Boolean
Private Sub cmdPause_Click()
IsRunning = False
End Sub
Private Sub cmdStart_Click()
IsRunning = True
End Sub
Private Sub Timer1_Timer()
Static LastTime As Date
If IsRunning Then
If DateDiff("n", lastdate, Now()) >= 4 Then
'sendkeys
LastTime = Now()
End If
End If
End Sub
The IsRunning variable is outside any procedure and is called a shared variable. Any procedure within this form can see it. The start & pause buttons turn the value of it to true or false.
The Timer event will run every sec. Here we're checking if IsRunning is true and also if 4 minutes has expired yet. If so, then you can run your sendkeys.
Related
I'm attempting to make a GUI for a school project in Excel of a basic security system. I'm trying to have the macro take the user to the alarm slide (slide 8) if the timer runs out and if the disarm boolean is false. However, as I have it now, no matter what the user is always taken to the alarm slide once the timer runs out. I'm not sure what the issue is exactly.
The ARM_DISARM is run by an action button on the disarmed slide.
Global Disarm As Boolean
Sub timelimit()
Disarm = False
ActivePresentation.SlideShowWindow.View.GotoSlide (3)
Dim time As Date
time = Now()
Dim count As Integer
count = 5
time = DateAdd("s", count, time)
Do Until time < Now()
DoEvents
For i = 3 To 6 'slide numbers'
ActivePresentation.Slides(i).Shapes("countdown").TextFrame.TextRange = Format((time - Now()), "hh:mm:ss")
Next i
Loop
If Disarm = False Then
ActivePresentation.SlideShowWindow.View.GotoSlide (8)
End If
End Sub
Sub ARM_DISARM()
Disarm = True
End Sub
I'm trying to mimic a screensaver on PowerPoint that will return to my first slide after X amount of seconds of inactivity.
The PowerPoint presentation is all just completely image based and every click will transition through the slides, so it doesn't have to be sophisticated at all, just that at the start of each slide it counts down 5 seconds, then returns to slide 1 (which is my fake screensaver page).
I've already got something working in a basic format, it takes you to the first page after 5 seconds, but the timer doesn't restart once you go to a new slide, once it starts counting down, regardless of if you move to the next slide after 3 seconds, you don't get another 5 second countdown, it just finishes the remaining 2 seconds and redirects you.
VBA is definitely not my primary language, I'm just piecing this together with what I can find, but my current code is below
Sub Auto_NextSlide(Index As Long)
Dim Delay, Start
If Index > 1 Then
Delay = 5
Start = Timer
Do While Timer < Start + Delay
DoEvents
Loop
SlideShowWindows(1).View.GotoSlide (SlideShowWindows(1).Presentation.Slides(1).SlideIndex)
End If
End Sub
Try maybe something like below (using class events)
' AppEvents class module
Option Explicit
Public WithEvents App As Application
Const Delay As Integer = 5
Dim Start
Dim actualSlide As Integer
Private Sub App_SlideShowNextSlide(ByVal Wn As SlideShowWindow)
With Wn.Presentation.SlideShowWindow
Start = Timer
actualSlide = .View.Slide.SlideIndex
If actualSlide > 1 Then
Do While Timer < Start + Delay
DoEvents
If .View.Slide.SlideIndex <> actualSlide Then
Start = Timer
actualSlide = .View.Slide.SlideIndex
End If
Loop
.View.GotoSlide (.Presentation.Slides(1).SlideIndex)
End If
End With
End Sub
Module code
' Module 1
Option Explicit
Public pApp As AppEvents
Sub GetAppClass()
Set pApp = New AppEvents
Set pApp.App = Application
ActivePresentation.SlideShowSettings.Run
End Sub
I am trying to work out how to get my progress bar to show the progress of the subroutine below. Does anyone have any ideas how to get the ball rolling on this one?
Any help or advice is appreciated.
Private Sub CommandButton8_Click()
Dim StartTime As Double
Dim MinutesElapsed As String
'Remember time when macro starts
StartTime = Timer
'*****************************
'Direct Data
Sheet4.Activate
Call Test1
Call Test2
Call Test3
Call Test4
'Return to Welcome Page
Sheet8.Activate
'*****************************
'Determine how many seconds the code took to run
MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss")
'Notify user in seconds
MsgBox "This code ran successfully in " & MinutesElapsed & " minutes",
vbInformation
End Sub
Here's what I use for a progress bar:
Application.StatusBar = "Processing... " & CInt(nRow / nLastRow * 100) & "% " & String(CInt(nRow / nLastRow * 100), ChrW(9609))
DoEvents ' optional
nRow is the increment number
nLastRow is the value for 100% complete
When the loop is complete, reset it like this:
Application.StatusBar = ""
The logic behind a progressbar is this:
have a userform with a Label (or image or button) with the image of your example photo. Put it in a frame. The width of the frame is initialised to zero and grows as your number grows by either calling a Public Sub inside the userform, of directly Userform1.Frame1.width=Percent*MaxWidth/100.
Sometime you would want to add a doevents, wich i use only every X cycles (if clng(percent) mod X = 0 then doevents , for example).
Step 1: design a progress dialog box. For the following example, it must have the name frmProgress and have two text labels lblMsg1 and lblMsg2
Step 2: insert the following code in the dialog's code module:
Sub ShowProgressBox()
Me.Show vbModeless
End Sub
Sub SetProgressMsg(msg1, msg2)
If (msg1 <> "") Then Me.lblMsg1 = msg1
If (msg2 <> "") Then Me.lblMsg2 = msg2
DoEvents
End Sub
Sub SetProgressTitle(title)
Me.Caption = title
DoEvents
End Sub
Sub EndProgressBox()
Unload Me
End Sub
You can call these functions from your code to show progress messages.
Step 3: in your code, at the beginning of the lengthy operation, call
frmProgress.ShowProgressBox
Step 4: during the lengthy operation, regularly call the set function to show the user information, for example in a loop:
frmProgress.SetProgressMsg "Searching in "+ myArray(i), "Working..."
Step 5: Once done, close the progress box:
frmProgress.EndProgressBox
I've made a workbook what has to be closed after 10 minutes of inactivity. I use a timer with Application.OnTime. I use the Application.OnTime command after every minute of inactivity, to refresh a message in the statusbar. In the last minute I use the Application.OnTime command after every second of inactivity to speed up the messages in the statusbar.
This works well, so far so good.
Public dtNextTime As Date
Public lngWaitTime As Long
Public lngRefreshTime As Long
Sub StartCountDownTimer()
Call StopCountDownTimer
dtNextTime = 0
lngWaitTime = 1 * 60 ' In my real workbook, the user can change the 10 minutes in a cell and I use this value in this sub
' Set initial RefreshTime
lngRefreshTime = 60
Call PlanNextTime
End Sub
Sub PlanNextTime()
Dim strWaitTime As String
Dim lngShowWaitTime As Long
If lngWaitTime >= 60 Then
lngShowWaitTime = lngWaitTime / 60
Else
lngShowWaitTime = lngWaitTime
End If
Select Case lngWaitTime
Case Is >= 120
strWaitTime = " minutes"
Case Is >= 60
strWaitTime = " minute"
Case Is > 1
strWaitTime = " seconds"
Case Is = 1
strWaitTime = " second"
End Select
Application.StatusBar = "If you don't use this workbook it will be closed in " & lngShowWaitTime & strWaitTime
If lngWaitTime <= 0 Then
Application.StatusBar = "Workbook is being closed"
Call CloseWorkbook
Else
If dtNextTime = 0 Then dtNextTime = Now()
If lngWaitTime > 60 Then
lngRefreshTime = 60
Else
lngRefreshTime = 1
End If
Application.OnTime EarliestTime:=dtNextTime, Procedure:="PlanNextTime", Schedule:=True
dtNextTime = dtNextTime + TimeSerial(0, 0, lngRefreshTime)
lngWaitTime = lngWaitTime - lngRefreshTime
End If
End Sub
Sub StopCountDownTimer()
On Error Resume Next
Application.OnTime EarliestTime:=dtNextTime, Procedure:="PlanNextTime", Schedule:=False
On Error GoTo 0
Application.StatusBar = False
End Sub
Sub CloseWorkbook()
' In my real workbook, at this place I call a sub to do some final things like saving the workbook
Application.StatusBar = False
ThisWorkbook.Close
End Sub
To test this, I used only the last minute. Then I found out I get strange problems with other manually started procedures. My preliminary conclusion: you can't run a manually started procedure together the a procedure started with the Application.OnTime command. I think I can find a workaround, but I want to be sure my conclusion is right. Excel VBA should be single-threaded, so I'm not sure my conclusion is right.
Therefore my question to you: is someone familiar with problems with procedures fired with the Application.OnTime command, fired on the same time a manual started procedure is running?
Do you know any way to deal with this issue?
I think your issue is that the Event you've created doesn't fire when an existing routine is running. That would be correct for the reason you surmised: Excel VBA is single-threaded.
Perhaps your 'manually started' procedure is amending records in a large table for instance or similar? If that's the case, insert a DoEvents into your loops to allow any pending events scheduled to be fired. This will cause the running to jump to your scheduled subroutine (PlanNextTime()) and complete that before returning to your loop.
I can't see much wrong with your posted code, though I confess I've not gone through it entirely to check your clever but confusing minutes vs seconds handling. I did notice however that you don't appear to be calling StopCountDownTimer() within your CloseWorkbook(). This will likely mean that on closing the workbook, or even Excel entirely, Excel will re-open the Workbook after closing to run your next scheduled event.
First of all I should say that I have no relevant experience in VBA but I badly need to make a timer in excel. I have managed to create stop and start buttons of the timer. But I have 20 different timers with start and stop buttons. I want to create a button that will be automatically start all timers while letting me stop individually a single timer.
I have produced the following code to start and stop them. But when I stop one of the timers I get the following error:"Run-time error '1004': Method 'onTime' of object'_application failed.
The code for the two start and stop buttons is:
Sub startTimer27()
Application.OnTime Now + TimeValue("00:00:01"), "Increment_count27"
End Sub
Sub Increment_count27()
Range("B2").Value = Range("B2") + 1
Range("B11").Value = Range("B11") + 1
Range("B19").Value = Range("B19") + 1
Range("B25").Value = Range("B25") + 1
Range("B33").Value = Range("B33") + 1
startTimer27
End Sub
Sub stopTimer27()
Application.OnTime Now + TimeValue("00:00:01"), "Increment_count27", Schedule:=False
End Sub
Have you considered using global variables saving the current time value?
Sub startTimer27()
starttime = Now
'MsgBox("The timer is running.")
End Sub
Sub stopTimer27()
timetaken = Now - starttime
MsgBox ("The time elapsed is " & Hour(timetaken) & ":" & Minute(timetaken) & ":" & Second(timetaken))
End Sub
Of course with your example it would be more like:
Public starttime(1 To 20) As Date
Sub cvbstartTimer27()
For i = 1 To 20
starttime(i) = Now
Next
End Sub
If you need to specifically stop it, then you'd have to give it a Boolean value too, that would be true when the timer is running and false when it's stopped. The lack of this value doesn't mean your code is wrong nevertheless.