I used the following code to have a Countdown which would span over 10 slides whilst in slideshow mode. I placed the shapes in a SlideMaster Layout.
Set QS = ActivePresentation.Designs(2).SlideMaster.CustomLayouts(2)
Dim Seconds As Integer
Seconds = 30
QS.Shapes("Counter").TextFrame.TextRange = Seconds
For i = 1 To 30
Dim WAIT As Double
WAIT = Timer
While Timer < WAIT + 1
DoEvents
Wend
Seconds = Seconds - 1
QS.Shapes("Counter").TextFrame.TextRange = Seconds
Next i
Dim time As Date
Dim count As Integer
time = Now()
count = 30
time = DateAdd("s", count, time)
Do Until time < Now
DoEvents
With ActivePresentation.Designs(2).SlideMaster.CustomLayouts(2).Shapes("Counter").TextFrame.TextRange
.Text = Format((time - Now()), "hh:mm:ss")
End With
Loop
Both the codes work properly if they are not placed in SlideMaster Layout.
Are there any better means to have a countdown that spans across multiple slides?
There is a better way to show a countdown by using the Format (Now(), "hh:mm:ss")
To create a countdown we need two values:
The current time
The future time when the countdown expires
Dim time As Date
Dim count As Integer
time = Now() 'the current time
count = 30
time = DateAdd("s", count, time) 'the future time after 30 seconds
The above gives us the two values.
Now, we can make a loop to change the text inside the Counter shape.
Do Until time < Now() 'We change text until the present time passes the set "future time"
DoEvents
For i = 1 To 10 'Assuming you want the countdown in slides 1 To 10
With ActivePresentation.Slides(i).Shapes("countdown").TextFrame.TextRange
.Text = Format((time - Now()), "hh:mm:ss")
End With
Next i
Loop
You can use this to have a countdown across multiples slides.
I mocked up similar code along the lines of:
Set Shape = Application.ActivePresentation.Designs(1).SlideMaster.CustomLayouts(1).Shapes("Testing")
Shape.TextFrame.TextRange.Text = "Did it work"
As you found, the shape's text did not change while presenting the slideshow, although it did update the underlying slide master once you left the slideshow. However, I found that by including the following after this code, it worked as expected:
Shape.Visible = msoTrue
Related
I set up a VBA routine in Word 2013 to create/display a calendar.
An array was set up for the weekdays, here's some of it:
Public arrDays As Variant
arrDays = Split("Mon,Tue,Wed,Thu,Fri,Sat,Sun,Mon,Tue,Wed,Thur,Fri,Sat,Sun", ",")
With .Rows(2)
.Cells.VerticalAlignment = wdAlignVerticalCenter
.Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
.Range.Font.Name = "Calibri"
.Range.Font.Italic = True
.Range.Font.Size = 28
.Height = 24
For J = 1 To 7
.Cells(J).Range.Text = arrDays(J + lngFirstDay - 2)
Next J
End With
When I place the .Cells(J).Range.Text in the specified cell number it starts with "Sun";
The watch window shows:
arrDays(0) "Sun"; arrDays(1) "Mon"; arrDays(2) "Tue";....
Mo matter how I arrange the weekdays in the split, it is the same.
The calendar routine does work, it's just this Split thing
Info that should have been in the original post:
Start of Calendar selection
Watch list of arrDays
First day of workweek - Sunday
Second day of workweek
Complete Calendar
It is fixed.
I moved Public arrDays As Variant from CallCalForm to Declarations and moved
arrDays = Split("Mon,Tue,Wed,Thu,Fri,Sat,Sun,Mon,Tue,Wed,Thur,Fri,Sat,Sun", ",")
from beginning of CallCalForm to top Sub CommandButton1_Click().
I'm not sure if moving around made a difference, maybe I had a typo somewhere. If I change the order of arrDays the outcome corresponds to the change.
I am creating a VB.Net chart with date/time as the xAxis labels. It is working fine but what I want to do is sync the second label to a even hour boundary. The chart should have the first label as the first date/time in the dataset, but the labels following would then be on a 6 hour (00:00 - 06:00 - 12:00 - 18:00) boundry. I could also live with not having the first axis label as long as the rest were on a 6 (or 12, depending on the length of the data) hour boundary.
Current:
07:00-------13:00-------19:00-------01:00-------07:00-------13:00
What I'm after:
07:00--12:00-------18:00-------00:00-------06:00-------12:00
Chart as currently produced
I've got it... sort of.
For area As Integer = 0 To numLanes -1
myArea = New ChartArea("myArea" & area.ToString)
With myArea
.BackColor = mySetup.colorPlotBackground ' set from user preferences
.Area3DStyle.Enable3D = mySetup.is3D ' set from user preferences
.AxisX.LabelStyle.Format = "g"
.AxisX.Interval = 1
.AxisX.IntervalType = DateTimeIntervalType.Days
.AxisX.IntervalOffset = 0
.AxisX.IntervalOffsetType = DateTimeIntervalType.Hours ' Set the X value type of the displayed series to DateTime.
End With
cht.ChartAreas.Add(myArea)
Produces the attached chart.
Slightly Improved
Hello I have this program that lets you start and stop time on a job the problem I am having now is that if it switches from A.M to P.M while time is tracked the program doesn't work right. so I have a button that puts the Time.Now when its pressed in a excel cell than when you stop the job it puts the End time in another cell and then it go's in and grabs the two cells and subtracts them. what I need it to do is put the Date and Time in the cell then both and only give me the Minutes and hours that it took. here is what I have for code.
'This code is for when you start the job.
'which this is only hours and minutes prob should be
'Date and Time
Dim StartTime As String = DateTime.Now.ToString("h\:mm")
'This line of code puts it in an excel cell
oXL.ActiveCell.Offset(0, 13).Value = StartTime
'This code is for when you end a Job.
'Again its only hours and minutes but prob should be
'Date and Time
Dim EndTime As String = DateTime.Now.ToString("h\:mm")
'This is the Total Time I am going to have
'I used TimeSpan
Dim TotalTime As TimeSpan
'Now this is where I put the End time when the
'Button is clicked.
oXL.ActiveCell.Offset(0, 14).Value = EndTime
'Once Both cells have the start and end Times I get them both with this code.
'Again this should prob be Date and Time.
Dim time1 = TimeSpan.ParseExact(oXL.ActiveCell.Offset(0, 13).Value, "h\:mm", CultureInfo.CurrentCulture)
Dim time2 = TimeSpan.ParseExact(oXL.ActiveCell.Offset(0, 14).Value, "h\:mm", CultureInfo.CurrentCulture)
'I then use this code to do my math.
TotalTime = time2 - time1
The Total time I need i only to be the hour an minutes that it took to do the job.
You are taking two dates, converting them and storing them into string variables, then reading them back into dates to calculate. You are hoping that they are in the right format when you parse them back, this in itself is top heavy. But why store dates as string at all? You can convert a date to a string at any time on the fly with the .ToString() method. Just keep them as dates and write them out to the excel sheet as strings when needed. The values will be the same either way, and you're not relying on your sheet to have the data in the adjacent locations, you will just perform the calculation and you are done.
'This code is for when you start the job.
'which this is only hours and minutes prob should be
'Date and Time
Dim StartTime As DateTime = DateTime.Now
'This line of code puts it in an excel cell
oXL.ActiveCell.Offset(0, 13).Value = StartTime.ToString("h\:mm")
'This code is for when you end a Job.
'Again its only hours and minutes but prob should be
'Date and Time
Dim EndTime As DateTime = DateTime.Now
'Now this is where I put the End time when the
'Button is clicked.
oXL.ActiveCell.Offset(0, 14).Value = EndTime.ToString("h\:mm")
'Once Both cells have the start and end Times I get them both with this code.
'Again this should prob be Date and Time.
' Dim time1 = TimeSpan.ParseExact(oXL.ActiveCell.Offset(0, 13).Value, "h\:mm", CultureInfo.CurrentCulture)
' Dim time2 = TimeSpan.ParseExact(oXL.ActiveCell.Offset(0, 14).Value, "h\:mm", CultureInfo.CurrentCulture)
'This is the Total Time I am going to have
'I used TimeSpan
Dim TotalTime As TimeSpan
'I then use this code to do my math.
TotalTime = EndTime.Subtract(StartTime)
'output time difference
MsgBox(TotalTime.ToString)
.:EDIT:.
To give you an example of total hours and minutes:
Dim startTime As DateTime = DateTime.Now 'read from excel instead
Dim endTime As DateTime = DateTime.Now.AddDays(1.5).AddMinutes(60) 'read from excel
Dim span As TimeSpan
span = endTime.Subtract(startTime)
MessageBox.Show("Total Hours: " & (span.Days * 24) + span.Hours & ", Total Mins: " & span.Minutes)
I hope this will be able to assist in your calculation (grabbing a start and end date string, converting it to DateTime, then outputting the hours and minutes):
'This code is for when you start the job.
'which this is only hours and minutes prob should be
'Date and Time
Dim StartTime As String = DateTime.Now.ToString("h\:mm")
'This code is for when you end a Job.
'Again its only hours and minutes but prob should be
'Date and Time
Dim EndTime As String = DateTime.Now.AddHours(3.5).ToString("h\:mm")
'This is the Total Time I am going to have
'I used TimeSpan
Dim TotalTime As TimeSpan
'Once Both cells have the start and end Times I get them both with this code.
'Again this should prob be Date and Time.
Dim time1 = DateTime.Parse(StartTime)
Dim time2 = DateTime.Parse(EndTime)
'I then use this code to do my math.
TotalTime = time2 - time1
Dim Hours = TotalTime.Hours
Dim Minutes = TotalTime.Minutes
System.Console.WriteLine(Hours & "h " & Minutes & "m")
So if I have lets say 10 textboxes I need to fill I have to repeat a loop 10 times and each time add to a different text box. Right now I have something like this:
If i = 0 Then
Shift0 = endTime - startTime
textStart0.text = startTime
textEnd0.text = endTime
chkBox0.checked = True
End If
I have I repeating like that 8 more times to make 9. I want to make it so that the loop would increase the number from 0-9 every time it goes through
If i = (x) Then
Shift(x) = endTime - startTime
textStart(x).text = startTime
textEnd(x).text = endTime
chkBox(x).checked = True
End If
x = x + 1
How can I put it in the loop so that the number in the name of the object increased with every loop?
Control arrays are a thing of the past, from the VB6 days, unfortunately, as you've discovered, they can still have their uses!
Try this for your loop;
For i = 0 to 9
Shift0 = endTime - startTime ' Is Shift0 a control!?
FindControl("textStart" & i).Text = startTime
FindControl("textEnd" & i).Text = endTime
FindControl("chkBox" & i).Checked = True
Next
With this function to help...
Private Function FindControl(pName As String) As Control
Dim vMatches = Me.Controls.Find(pName, True)
If vMatches IsNot Nothing AndAlso vMatches.Length > 0 Then Return vMatches(0)
Throw New Exception("Could not find the specified control!")
End Function
Having said all that, I would strongly recommend re-thinking how your form and application work to avoid this!
Something like this would work
For x = 0 to 9
Shift(x) = endTime - startTime
textStart(x).text = startTime
textEnd(x).text = endTime
chkBox(x).checked = True
next x
You can use the Controls property of a Control with an index. If your form contains exactly and only 10 textboxes, this will work fine:
For i as Integer = 1 to 10
Form1.Controls(i).Text = "Box " + i.ToString()
Next
If you have other controls in the form you have no guarantee over the index (you can't reply on 1 to 10 being the textboxes as your design progresses). Therefore, I'd recommend you put them inside a panel and refer to this panel's Controls:
For i as Integer = 1 to 10
Panel1.Controls(i).Text = "Box " + i.ToString()
Next
To learn more about loops in VB.NET, start here: http://www.tutorialspoint.com/vb.net/vb.net_loops.htm
There are around 500 slides, the first slide is an introduction, second slide is for instructions with the action button for the Start_time macro - once clicked the timer starts. Slides 3 - 499 have one word in each, so the reader will have to go through each of the slide in a period of time, that's why the word_count equals slide.count minus three. The last slide will have the action button that when clicked will show the reading evaluation.
This macro is for my PowerPoint presentation intended to give a reading evaluation to my students.
Dim Start_time As Date
_______________________________________________________________________________________
Sub Start_time()
'at action button click in the first slide the time starts counting
Start_time = Now()
End Sub
_______________________________________________________________________________________
Sub ReadingTime()
'at action button click on the last slide the evaluaton message appears
Dim Reading_Time As String
Dim End_Time As Date
Dim iTotal_time As Long
Dim Word_count As Integer
End_Time = Now()
iTotal_time = DateDiff("d", End_Time, Start_time)
Word_count = ActivePresentation.Slides.Count - 3
Reading_Time = Word_count / iTotal_time * 24 * 60
MsgBox "Evaluation : Your reading speed is " & Reading_Time & "words per minute"
End Sub
Didn't you mean end_time = now()?!!!
Another deeper issue is you probably want to declare start_time at the top of the module as it will go out if scope (I.e. will no longer be available) once the start_time sub exits: type
dim start_time
right at the top of the module to do this.
Try this:
Dim m_start_time As Date 'renamed this as it clashes with a function name
Public Sub Start_time()
'at action button click in the first slide the time starts counting
m_start_time = Now()
End Sub
Public Sub ReadingTime()
'at action button click on the last slide the evaluaton message appears
Dim Reading_Time As String
Dim End_Time As Date
Dim iTotal_time As Double 'use a double as fraction days are important
Dim Word_count As Integer
End_Time = Now()
iTotal_time = End_Time - m_start_time
Word_count = ActivePresentation.Slides.Count - 3
Reading_Time = Word_count / iTotal_time * 24 * 60
MsgBox "Evaluation : Your reading speed is " & Reading_Time & "words per minute"
End Sub