Good morning,
I am working on a macro to autorefresh excel links before slideshow, loop through slideshow and then restart over and over again. The issue I am having is the slideshow stops but doesnt exit so the wait timer doesnt have a chance to even kick in.
Can I get a suggestion of how I might fix this?
Sub LoopAllSlides()
Dim i As Integer
For i = 0 To 2000
Dim Endpoint As Single
Endpoint = Timer + 10
Do While Timer < Endpoint 'This loop works dont delete
DoEvents
Loop
ActivePresentation.UpdateLinks
With ActivePresentation.SlideShowSettings
.AdvanceMode = ppSlideShowUseSlideTimings
.LoopUntilStopped = msoFalse
.Run
End With
Next i
End Sub
You can always do this with the Application.Quit function, which will exit out of your current sub. So, something like this:
Sub LoopAllSlides()
Dim i As Integer
For i = 0 To 2000
Dim Endpoint As Single
Endpoint = Timer + 10
Do While Timer < Endpoint 'This loop works dont delete
DoEvents
Loop
ActivePresentation.UpdateLinks
With ActivePresentation.SlideShowSettings
.AdvanceMode = ppSlideShowUseSlideTimings
.LoopUntilStopped = msoFalse
.Run
End With
Next i
'Quit Application Function
IWishICouldQuitYou
End Sub
Function IWishICouldQuitYou()
With Application
For Each w In .Presentations
w.Save
Next w
.Quit
End With
End Function
Related
I'm trying to write a vba script that gets called in a batch file to open an excel file, refresh bloomberg data, save the file, and then quit excel.
There was a historical question which asked something similar, but the suggested answer didn't seem to work - I can open the file and refresh the data, but it doesn't save the file or close excel.
I tried also putting in as a macro with the workbook_open file, but then ran into a problem where excel is saving and closing the file before refreshing the data. Any suggestions would be much appreciated.
Immediately below is the modified vba code that refreshes the data, but doesn't save or close the excel workbook.
'Write Excel.xls Sheet's full path here
strPath = "C:\MngXL\testbook.xlsm"
'Create an Excel instance and set visibility of the instance
Set objApp = CreateObject("Excel.Application")
objApp.Visible = True
Set wbToRun = objApp.Workbooks.Open(strPath)
StartAutomation
DoneNow
Sub StartAutomation()
Dim oAddin
Set oAddin = objApp.Workbooks.Open("C:\blp\API\Office Tools\BloombergUI.xla")
If Not oAddin Is Nothing Then
objApp.DisplayAlerts = False
objApp.Calculate
objApp.Run "RefreshAllStaticData"
objApp.Calculate
objApp.Run "RefreshAllStaticData"
'WaitTillUpdateComplete
End If
dim count
dim updated
updated = false
for count = 0 to 12
if updated = false then
if objApp.WorksheetFunction.CountIf(objApp.Range("rng_inWorkbook"),"#N/A Requesting Data...") = 0 Then
updated = true
else
Application.OnTime Now + TimeValue("00:00:15"), WaitTillUpdateComplete
end if
end if
next
End Sub
Private Sub WaitTillUpdateComplete()
Dim t
t = 0
objApp.Calculate
If objApp.WorksheetFunction.CountIf(objApp.Range("rng_inWorkbook"),"#NAME?") > 0 Then
Application.OnTime Now + TimeValue("00:00:15"), "WaitTillUpdateComplete"
ElseIf objApp.WorksheetFunction.CountIf(objApp.Range("rng_inWorkbook"),"#N/A") > 0 Then
Application.OnTime Now + TimeValue("00:00:15"), "WaitTillUpdateComplete"
ElseIf objApp.WorksheetFunction.CountIf(objApp.Range("rng_inWorkbook"),"#N/A Requesting Data...") > 0 Then
If t < 5 Then
t = t+ 1
waitlonger
Else
Exit Sub
End If
Else
Exit Sub
End If
End Sub
Sub waitlonger()
Dim x
x = Now + TimeValue("00:00:40")
Do While x > Now
Loop
objApp.Calculate
End Sub
Sub DoneNow()
wbToRun.Save
wbToRun.Close
objApp.DisplayAlerts = False
objApp.Quit
MsgBox strPath & " " & strMacro & " macro and .vbs successfully completed!!!!", vbInformation
End Sub
You need a strategy to let the refresh of Bloomberg data take about the right amount of time.
Currently, your program seems to allow only certain small amounts of time to pass with no feedback. Instead, you need to make a loop that cycles once every 10 seconds (or whatever makes sense) and checks to see if the program is done.
I like to do it this way:
dim count as integer
dim updated as boolean
updated = false
for count = 1 to 12 'or any value you choose
if updated = false then
if objApp.WorksheetFunction.CountIf(objApp.Range("rng_inWorkbook"),"#NAME?") = 0 Then
updated = true
else
Application.OnTime Now + TimeValue("00:00:15"), "WaitTillUpdateComplete"
end if
end if
next
I have this piece of code which I would like to show and hide some Shape objects one by one, in order to make a little animation. However, nothing happens as the code executes, all images are shown by once when the code stops running.
Sub test()
For i = 1 To 4
Sheets("Game").Shapes("North" & i).Visible = True
Sleep 500
'Sheets("Game").Shapes("North" & i).Visible = False
'by setting it to false i'd like to achieve the animation effect
Debug.Print i
DoEvents
Next i
End Sub
DoEvents allows other code (e.g. Excel's own) to run and handle things like user clicking on another worksheet (which invokes any Worksheet.Change or Workbook.WorksheetChange handler)... or just repainting itself.
By invoking DoEvents once per loop, Excel doesn't get a chance to repaint between the visibility toggles: it's already busy running your loop.
So you need to toggle visibility on, let Excel repaint (DoEvents), sleep for your animation delay (500ms seems a tad slow IMO), then toggle visibility off and let Excel repaint again, i.e. invoke DoEvents one more time.
If the Game worksheet is in ThisWorkbook, then I'd warmly recommend you give it a CodeName - select it in the Project Explorer, then look at its properties (F4) and change its (Name) to, say, GameSheet.
This gives you a global-scope object variable so that you don't need to dereference the same worksheet twice per iteration - heck you could even dereference its Shapes collection only once:
Private Const ANIMATION_DELAY As Long = 100
Sub test()
With GameSheet.Shapes
For i = 1 To 4
Dim currentShape As Shape
Set currentShape = .Item("North" & i)
currentShape.Visible = True
DoEvents
Sleep ANIMATION_DELAY
currentShape.Visible = False
DoEvents
Debug.Print i
Next
End With
End Sub
Amended the code by setting DoEvents after toggling True and Falseand now it works:
Sub test()
For i = 1 To 4
Sheets("Game").Shapes("North" & i).Visible = True
DoEvents
Sleep 100
Sheets("Game").Shapes("North" & i).Visible = False
DoEvents
'by setting it to false i'd like to achieve the animation effect
Debug.Print i
Next i
End Sub
I'm trying to learn countdown macros and I downloaded this file from Jerry Beaucaire's website. Thank you Jerry!
I tweaked it a little. Rather than counting a value from 0 to an infinite number, I made it to countdown a value to zero from a number that I type in column C. But an error occurs when a number reaches zero. How do I fix this error? And how do I make a button in column A switch back to "DOWN" when a number reaches zero?
Dim CountDown As Date
Sub Timer()
DisableTimer
CountDown = Now + TimeValue("00:00:01")
Application.OnTime CountDown, "Reset"
End Sub
Sub Reset()
Dim Counter As Range
Application.ScreenUpdating = False
Application.EnableEvents = False
If Evaluate("COUNT(B2:B5)") = 0 Then
Call DisableTimer
Else
For Each Counter In ThisWorkbook.Sheets("Sheet1").Range("B2:B5")
If Not IsEmpty(Counter) Then Counter = Counter - TimeValue("00:00:01")
Next Counter
Call Timer
End If
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
Sub DisableTimer()
On Error Resume Next
Application.OnTime EarliestTime:=CountDown, Procedure:="Reset", Schedule:=False
End Sub
Source File
Replace this:
If Not IsEmpty(Counter) Then Counter = Counter - TimeValue("00:00:01")
With this:
If Counter > TimeValue("00:00:01") Then
Counter = Counter - TimeValue("00:00:01")
Else
Counter = ""
End If
i have s Sub() like this, to download HTML page using GeckoWebBrowser
wb1 = Nothing
wb1 = New Gecko.GeckoWebBrowser
wb1.Navigate(v_url)
totalticks = 0
loadtimer.Start()
Do
If m_stop = True Then Exit Do
If wb1.IsBusy = False Then 'wb1.ReadyState = WebBrowserReadyState.Complete Then
If IsNothing(wb1.Document) = False Then
If IsNothing(wb1.Document.Body) = False Then
Exit Do
End If
End If
ElseIf wb1.IsBusy = True And String.IsNullOrEmpty(sucessID) = False Then 'wb1.ReadyState = WebBrowserReadyState.Interactive And String.IsNullOrEmpty(sucessID) = False Then
If IsNothing(wb1.Document) = False Then
If IsNothing(wb1.Document.Body) = False Then
If InStr(wb1.Document.Body.InnerHtml, sucessID, CompareMethod.Text) <> 0 Then
Exit Do
End If
End If
End If
End If
If totalticks = 15 Then
'wb1.Dispose()
wb1.Stop() 'wb1 = New System.Windows.Forms.WebBrowser
wb1.Reload(Gecko.GeckoLoadFlags.IsRefresh)
'wb1.ScriptErrorsSuppressed = True
'wb1.Navigate(v_url)
ElseIf totalticks >= 30 Then
wb1.Stop()
Exit Do
End If
'FreeUpMemory()
Application.DoEvents()
Loop
My problem is that Application.DoEvents takes a long time to process and finish.
P.S i am using STA thread to run this Sub()
Ok people here is how my problem was solved, and thanks for the others who tried to help! much appreciated. Ok here it goes:
Basically this 2 lines where in loop
wb1 = Nothing
wb1 = New Gecko.GeckoWebBrowser
So this for some reason was making the messages queue too crowded therfore the application.doevents was taking too long to process those messages.
So all i did was decalring wb1 as gloabl object (i.e. dim wb1 as New GeckoWebBrowser) this way i didnt need to set it to nothing then initialize the object again. So anyway i removed the above 2 lines and used the instaniated object instead.
Now things running so smooth and fast, even with DoEvents() !!! YAY!!
Try using a BackgroundWorker instead of running the Download on the Main thread. You can pass results from the Backgroundworker back to the Main thread through the Result property that gets passed to the RunWorkerCompleted event handler. You don't need the Application.DoEvents in your loop then and still have the Main thread responsive.
See this link for a tutorial:
http://msdn.microsoft.com/en-us/library/cc221403%28v=vs.95%29.aspx
I am trying to removeconnection from my work book but I am still geting run-time error 5. I dont know what to do because in my other projects it works.
Thanks for advice. Greeting from czech Republic.
Sub refresh_all()
Dim i As Integer
'~~> refresh workbook query
Application.DisplayAlerts = False
Workbooks("UAC_report_p.xlsb").Activate
'~~> wait for refresh then execute Call save_as
Do Until Application.CalculationState = xlDone
DoEvents
Loop
ActiveWorkbook.RefreshAll
Workbooks("UAC_report_p.xlsb").Activate
'~~>kill all connections
For i = 1 To ActiveWorkbook.Connections.Count
If ActiveWorkbook.Connections.Count = 0 Then Exit For
ActiveWorkbook.Connections.Item(i).Delete
i = i - 1
Next i
Application.DisplayAlerts = True
End Sub
P.S. getting error on
ActiveWorkbook.Connections.Item(i).Delete
You could try this in the for loop for deleting, using the minimal index 1 (One = 2/2) in VBA in place of i variable:
ActiveWorkbook.Connections.Item(1).Delete
Instead of
ActiveWorkbook.Connections.Item(i).Delete
As you delete, ActiveWorkbook.Connections.Count() will diminish, Some .item(i) does no more exist.
Or this:
'~~>kill all connections
For i = ActiveWorkbook.Connections.Count To 1 Step -1
ActiveWorkbook.Connections.Item(i).Delete
Next
Why not using the built-in enumerator of the connections collection?
Public Sub DeleteAllConnectionsInWorkbook()
Dim aConn as Object
For Each aConn in ActiveWorkbook.Connections
aConn.Delete
Next aConn
End Sub