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
Related
I'm trying to make a choose your own type of game in powerpoint. The game includes a point system that I did using a macro when the user is clicks an option. I also need a hyperlink to jump to the right slide in accordance to the option that was picked.
I tried creating 1 macro for every button, assigning where to slide to jump to, but this becomes solution way too messy since, by the end of the game, there would be hundreds of buttons = hundreds of macro.
Dim numCorrect As Integer
Dim numIncorrect As Integer
Dim userName As String
Dim printableSlideNum As Long 'ADDED
Sub GetStarted()
Initialize
ActivePresentation.SlideShowWindow.View.Next
End Sub
Sub Initialize()
numCorrect = 0
numIncorrect = 0
ActivePresentation.SlideShowWindow.View.Next
End Sub
Sub Right()
numCorrect = numCorrect + 10
End Sub
Sub Wrong()
numIncorrect = numIncorrect + 25
End Sub
Sub Feedback()
MsgBox "You spent " & numCorrect + numIncorrect & " minutes to solve the issue" & vbCr & _
"Out of the " & numCorrect + numIncorrect & ", you wasted " & numIncorrect & " minutes by choosing the wrong options"
End Sub
Sub JumpTo(lSlideIndex As Long)
SlideShowWindows(1).View.GotoSlide (lSlideIndex)
End Sub
Sub ONEA()
Right
JumpTo 6
End Sub
I had an idea of creating a macro that jumped to a slide number according to the name of the shape, but don't know whether it is possible or not.
Example: option B jumps to slide 60
the shape name would be 60
the vba will match the shape name and jumps to slide 60
Any help/ideas for this is appreciated!
Note: my VBA skills is essentially zero.
To name your shape see How to name an object within a PowerPoint slide?
Sub JumpToSlide(oShp As Shape)
lSlideIndex = CLng(oShp.Name)
SlideShowWindows(1).View.GotoSlide (lSlideIndex)
End Sub
To assign this macro to the shape you can right-click on the shape --> Hyperlink --> Run a Macro --> Select "JumpToSlide"
EDIT: I figured it out myself. I feel pretty silly, but replacing "Exit Sub" with "End" works perfectly.
Background: I have a Sub that uses the "Call" function to run multiple subs within one Sub (see Code #1 below).
Option Explicit
Sub MIUL_Run_All()
Dim StartTime As Double
Dim SecondsElapsed As String
'Remember time when macro starts
StartTime = Timer
Call OptimizeCode_Begin
Call Format_MIUL
Call Custom_Sort_MIUL
Call Insert_Process_List
Call Format_Process_List
Call OptimizeCode_End
'Determine how many seconds code took to run
SecondsElapsed = Format((Timer - StartTime) / 86400, "ss")
'Notify user in seconds
MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation
End Sub
My first code that is called out, "Format_MIUL", prompts the user to save the file, using the following line of code (see Code #2 below). This code works, but the problem is that if the user presses the "Cancel" button, the rest of the code called out in the main sub (Code #1 above) will continue to run. I want ALL code to stop if the user presses the cancel button. I just can't seem to figure out how to do that.
'Save file as .xlsm
MsgBox " Save as Excel Workbook (.xlsx)!"
Dim userResponse As Boolean
On Error Resume Next
userResponse = Application.Dialogs(xlDialogSaveAs).Show(, 51)
On Error GoTo 0
If userResponse = False Then
Exit Sub
Else
End If
Any help is greatly appreciated.
The Call keyword has been obsolete for 20 years, you can remove it.
The End keyword will effectively end execution, but it's pretty much a big red "self-destruct" button that you effectively never need to use, given properly structured code.
Looks like Format_MIUL is a Sub procedure. Make it a Function and return a Boolean value that tells the caller whether it's ok to proceed, or if the rest of the operations should be cancelled:
Private Function Format_MUIL() As Boolean
'...
'Save file as .xlsm
MsgBox " Save as Excel Workbook (.xlsx)!"
Dim userResponse As Boolean
On Error Resume Next
userResponse = Application.Dialogs(xlDialogSaveAs).Show(, 51)
On Error GoTo 0
'return False if userResponse isn't a filename, True otherwise:
Format_MUIL = Not VarType(userResponse) = vbBoolean
End Function
And now instead of this:
Call Format_MIUL
The caller can do this:
If Not Format_MIUL Then Exit Sub
And there you go, graceful exit without any self-destruct buttons pressed.
I'm trying to change the text displayed in the status bar in Excel 2015 using VBA. However, it doesn't seem to be updated. The message "Ready" remains there.
Function testStatusBar(delay As Long)
Dim progress As Long
For progress = 1 To delay
Application.StatusBar = "Progress: test ongoing ...." & (progress / delay) & "%"
DoEvents
Next progress
Application.StatusBar = False
End Function
I also tried many answers that where given here on this website for similar questions, however nothing worked. Is something wrong with the code or do I have to change some settings?
Your function works fine, but I suspect that you are calling it as a UDF from an Excel cell. UDFs are not permitted to update the status bar, or make any other changes to the Excel environment. (Basically, a UDF is allowed to return a value and that's it.)
If you called that function from a piece of VBA code, it works OK, providing you change it to return a value such as:
Function testStatusBar(delay As Long) As String
Dim progress As Long
For progress = 1 To delay
Application.StatusBar = "Progress: test ongoing ...." & (progress / delay) & "%"
DoEvents
Next progress
Application.StatusBar = False
testStatusBar = "Finished"
End Function
(You could then call it from other VBA code by saying myReturnValue = testStatusBar(200000)
Or change it to a Sub instead of a Function, i.e.
Sub testStatusBar(delay As Long)
Dim progress As Long
For progress = 1 To delay
Application.StatusBar = "Progress: test ongoing ...." & (progress / delay) & "%"
DoEvents
Next progress
Application.StatusBar = False
End Sub
(and then call it by saying testStatusBar 200000.)
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.
I am making my first Powerpoint 2007 macro and I am having a bit of trouble with it hanging, and not letting me move on to the next slide. I can press ESCAPE to quit the slideshow, but pressing space bar or anything else won't progress to the next slide. After a while, it just crashes. I come from a C++/Java background so I think its just something basic that I'm missing.
Basically I am trying to do a counter slide that counts the days/minutes/seconds from a particular date. When the slide loads I want it to show, in real time, how long its been since that date. I've put it through an infinite loop, which works fine to update the time, but then doesnt let me move on to the next slide.
Here's my code:
Sub OnSlideShowPageChange(ByVal SSW As SlideShowWindow)
'If SSW.View.CurrentShowPosition = 3 Then
Do While SSW.View.CurrentShowPosition = 3 ' infinite loop
Dim currentSlide As Integer
currentSlide = SSW.View.CurrentShowPosition
Dim startDate As Date
Dim currentDate As Date
Dim sngDiff As Single
Dim lngDays As Long
Dim lngHours As Long
Dim lngMinutes As Long
Dim lngSeconds As Long
startDate = #7/22/2011 2:00:00 PM#
currentDate = Now
sngDiff = currentDate - startDate
lngDays = CLng(sngDiff)
sngDiff = sngDiff - lngDays
lngHours = Hour(sngDiff)
lngMinutes = Minute(sngDiff)
lngSeconds = Second(sngDiff)
With ActivePresentation.Slides(currentSlide)
With .Shapes(2)
.TextFrame.TextRange.Text = "It has been:" & lngDays & " Days " & lngHours & " hours " & lngMinutes & " minutes " & lngSeconds & " Seconds"
End With
End With
DoEvents
Loop
End Sub
Do I need to listen for some sort of button click to stop this infinite loop, or how do I do this?
Thanks.
A user form is something you add in the VBA editor; it's what you'd normally think of as a dialog box, though forms can be used for other things and needn't even become visible; that's what we're going to do here:
Option Explicit
Public bFormCodeRunning As Boolean
Sub FormDemo()
' Set a flag to let us know the code in the form
' is running
bFormCodeRunning = True
' "show" the form
UserForm1.Show vbModeless
End Sub
Sub KillForm()
' call this at some other point in the presentation
' when you're sure you're done running the form code
If Not bFormCodeRunning Then
Unload UserForm1
End If
' You could actually call this from your slide change event handler
End Sub
Then Insert, User Form from the menu to add a new form; doubleclick it to view its code and add this:
Private Sub UserForm_Activate()
' Don't show my face
Me.hide
DoEvents
' prove that the form's loaded
MsgBox "I'm well-formed"
DoEvents
' and put your other code here
' and when the code's done, flag it
bFormCodeRunning = False
End Sub
For doing a time delay in a VBA context it is usually better to use a form_timer object so in your code have:
If SSW.View.CurrentShowPosition = 3 Then
Me.TimerInterval = 1000
Else
Me.TimerInterval = 0
End If
Or something similar. Then in the form timer code have your clock update code
Private Sub Form_Timer()
// Your clock update code here
End Sub
It's been years since I've done any VBA so I'm a bit rusty but I hope this helps. In general use timers instead of loops for threading tasks, VBA doesn't cope well with them.
The problem is that your routine "owns" the app; until it exits, you won't be able to do anything manually (ie, advance to the next slide).
Whether or not you use a timer on a form (and fwiw, the Timer control isn't shipped with VBA as it is with VB), I think a form may be your solution.
Have your event handler load a form modelessly then exit.
The code in the form can then do any mods to slides or whatever else you want.
Include DoEvents often enough that you don't slow down the main app, but the code in the form will run independently of what the main app is doing.
You don't need to make the form visible (and probably don't want to).