Thanks for the prompt reply Glen. Was useful when I got home - unfortunately,
our business network prohibits downloads such as zip files, so I had to wait
with baited breath.
Perhaps you would not mind helping with another query, for which I have
attached the code below. Don't laugh too hard at it - I'm still fairly new to
coding VBA (hence the moniker) and this is my first attempt with PoweePoint.
Basically, the PowerPoint slide keeps the work station unlocked and each
hour, switches to an Excel document which runs an automated report. Whilst
the Excel report is not running, the slide show runs with a shape that is
populated with the current time.
It waits for the clipboard to populate with a value (which Excel generates)
or until it times out, and then continues running the slide.
The problem - the show is not regaining focus once Excel has finished.
Would you, or someone, mind having a quick scan through the code and seeing
if there may be a solution. Oh, and the reason I AppActivate MS PowePoint and
then the slide is because it is the only was the workstation will not lock.
Thanks again,
____________________________________________________________________
Code
------
Public myDocument As Object
Dim RepVal As String
Dim RepTime
Dim Oldtime
Dim Response
Dim TextTime
Sub ASARunner()
counter = 1
Application.WindowState = ppWindowMinimized
ActivePresentation.SlideShowSettings.Run
On Error GoTo errorpoint
Set myDocument = ActivePresentation.Slides(1)
Dim myObj As New DataObject
Set myObj = New DataObject
Do
myObj.SetText ""
waiter (0.45)
RepTime = Format(Format(Right(Format(Now(), "hh:mm"), 2), "0") +
(Right(Format(Now(), "hh:mm:ss"), 2) / 60), "0.0")
TextTime = Format(Now(), "hh:mm:ss")
If RepTime > 1.1 And RepTime < 1.3 Then
AppActivate ("Global ASA Report v4.dev.xls"), False
SendKeys "^(+a)", True
Oldtime = Timer
Do
waiting = DoEvents
myObj.GetFromClipboard
On Error Resume Next
RepVal = myObj.GetText(1)
Loop Until RepVal = "Yes" Or Timer - Oldtime > 600
On Error GoTo errorpoint
If RepVal = "Yes" And TextTime > "09:00:00" And TextTime <
"17:00:00" Then
myObj.SetText ""
AppActivate ("Microsoft Excel - Global"), False
SendKeys "^(+b)", True
Oldtime = Timer
Do
waiting = DoEvents
myObj.GetFromClipboard
On Error Resume Next
RepVal = myObj.GetText(1)
Loop Until RepVal = "Done" Or Timer - Oldtime > 180
On Error GoTo errorpoint
If RepVal <> "Done" Then
AppActivate "PowerPoint Slide", False
MsgBox "There has been an error with Excel", vbOKOnly,
"Report..."
Exit Sub
End If
ElseIf RepVal = "Yes" And TextTime < "10:00:00" Or TextTime >
"17:00:00" Then
GoTo NextPoint
Else
AppActivate "PowerPoint Slide", False
MsgBox "There has been an error with Excel", vbOKOnly, "Report..."
Exit Sub
End If
End If
NextPoint:
myDocument.Shapes("Rectangle 9").TextFrame.TextRange.Text = TextTime
AppActivate "Microsoft PowerPoint", False
AppActivate "PowerPoint Slide", False
SlideShowWindows(Index:=1).View.First
waiter (0.45)
errorpoint:
If Err <> 0 Then
Response = MsgBox(Err.Description & vbNewLine & vbNewLine &
"Continue..?", vbYesNo + vbCritical)
If Response = 7 Then Exit Sub
End If
Loop Until TextTime > "16:12:00
-----------------------------------------------------------------------------------------------
End Sub
Sub waiter(wait)
Oldtime = Timer
Do
waiting = DoEvents
Loop Until Timer > Oldtime + wait
End Sub
____________________________________________________________________
