So, I've been banging my head against this one for a few days now, and figured it couldn't hurt to see if someone else has a solution.
I'm programming a macro in VBA for PowerPoint. Amongst other things, it needs to copy and paste multiple shapes (approximately 40 every time it's run). However, it randomly stops with an error:
This happens at random points during execution, not at the same point every time; sometimes it will instead paste the previous shape, causing other issues; and sometimes it will fully execute with no problems. I have tried numerous suggested fixes that I've found here and on other sites, and nothing seems to be working.
Right now, this is the relevant bit of code:
ClearClipboard
newPriorityShape.Copy
DoEvents
Set pastedShp = curSlide.Shapes.PasteSpecial(ppPasteDefault)
ClearClipboard
And for ClearClipboard I have:
Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
Public Function ClearClipboard()
OpenClipboard (0&)
EmptyClipboard
CloseClipboard
End Function
If anyone has any other suggestions, I'd be most grateful.
A little bit too late but I ran into the same issue recently. The implementation of the clipboard history on Windows conflicts with this, so in order to avoid those random errors you need to disable it.
Related
I have some complex code which takes some user inputs (names of shapes to copy) then copies said shapes from one sheet to another multiple times. The items are grouped shapes drawn in Excel and all named correctly and uniquely.
I receive copy and paste errors intermittently "Method 'Paste' of object _Worksheet' failed" and "Method 'copy' Of Object '_worksheet' Failed. Through researching the problem we understand that it is fairly common and has something to do with programmes which conflict with Excel when they are accessing the clipboard.
So far, my colleague and I have deduced that 2 programmes in particular interfere the most with the copy/paste operations - Adobe Reader and Autodesk Powershape. (Autodesk and Adobe both have Reference Libraries available within VBA, not sure if this is a coincidence?)
The problem used to occur very frequently whilst we had the programmes open, so we wrote the following macros/functions to try and stablise the code:-
Public Sub CopyShape(ItemName, CopyDestination)
Call ClearClipboard Sheets(CopyDestination).Shapes(ItemName).Copy
Do Until IsClipboardEmpty = False DoEvents Loop
End Sub
Where "ClearClipboard" is:-
Public Function ClearClipboard()
OpenClipboard (0&)
EmptyClipboard
CloseClipboard
End Function
and the function IsClipboardEmpty is:-
Function IsClipboardEmpty() As Boolean
IsClipboardEmpty = (CountClipboardFormats() = 0)
End Function
with the following public declarations:-
Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Declare Function EmptyClipboard Lib "user32" () As Long
Declare Function CloseClipboard Lib "user32" () As Long
Public Declare Function CountClipboardFormats Lib "user32" () As Long
This code works quite a lot of the time (far better than trying to use "DoEvents" after the copy operation which just failed miserably) as it forces the code to check if the copied item is in the clipboard before trying to paste it, but it doesn't always work - something in the background still messes up the code.
Is there any way of either:-
locking and unlocking the clipboard using VBA or APIs?
using a completely different method of copying and pasting the shapes?
Any and all solutions welcome and of course happy to answers any questions.
Thanks
VBA - 7.1. PowerPoint 2013
I am trying to achieve a small animation for an image on a slide (hide - wait half a sec - show).
I had noticed earlier that MsgBox usually pops up before the previous line of code gets completely executed. While it was annoying, I did't bother about it much. However, same behavior with Sleep is making my approach falls apart. I don't know how the system process management (or threads or whatever) is done internally by PowerPoint but it seems to have some problem.
I have tried following so far
1:
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
Sub SleepTest()
ActivePresentation.Slides("Slide 1").Shapes("Worker").Visible = 0
Sleep 5000 'delay in milliseconds
ActivePresentation.Slides("Slide 1").Shapes("Worker").Visible = 1
End Sub
Resut:-> Nothing happens. Before visibility is set to 0, sleep kicks in, wait for 5 seconds, image hides and shows within a millisec (so you cant see it happened)
2:
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
Sub SleepTest()
ActivePresentation.Slides("Slide 1").Shapes("Worker").Visible = 0
MsgBox("temptemptemp")
Sleep 5000 'delay in milliseconds
ActivePresentation.Slides("Slide 1").Shapes("Worker").Visible = 1
End Sub
Result: -> MsgBox pops up immediately, after few seconds while msgbox is shown, the image hides, click ok, application waits for 5 secs, image is shown back.
3:
I tried putting hiding and showing steps in two different subs and tried calling second sub after the sleep. It also showed the same behavior as the first attempt.
Can anyone provide some explanation for this behavior? Or suggest any other way to achieve what I am trying for.
how do I get out the time my VBA script takes to execute?
I know from PHP that there is something like microtime() which is called once before the script and once after in order to be able to calculate the difference from this values...
Is there an VBA equivalent?
It's a sample code that I used in one of my VBA projects to measure the performance of my script temporarily.
Also you can find ample of resources to optimize your script's performance
Public Sub generate(ByRef generators() As Generator)
Dim startTime As Double
OptimizePerformance doc
'/////////////////below is the line that matters
startTime = Timer
'////////// your code that is to be measured (in time) here //////////
MsgBox Format(Timer - startTime, "00.00") & " seconds"
removeOptimization doc
End Sub
There's a function called Timer() that returns time in seconds since midnight. Includes milliseconds. I don't know of a micro-second resolution timer in VBA.
An article on About.com suggests that it's possible to write your own microtimer by making Win32 API calls directly from VBA.
In case you need more accurate timing information, I would recommend using one of the following functions the get the start and end times
#If Win64 Then
Private Declare PtrSafe Function GetTickCount Lib "kernel32" () As LongLong
Private Declare PtrSafe Function timeGetTime Lib "winmm.dll" () As LongLong
#Else
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
#End If
They should return more precise information, depending on systems. Personally, on Win7 64bit / Office 2010/2013 32bit environments I prefer timeGetTime
Note that the absolute values of timeGetTime are not recommended to be used, but the DIFFERENCE (e.g. endTime-startTime) is a quite accurate value in miliseconds
I noticed that Office 2010 comes with Visual Basic for Applications 7.0. However I can't seem to find much documentation on what changes were made. Does anyone have a summary of the changes, or any resources describing the differences?
There's not a whole lot that has changed between VBA6 and VBA7. VBA7 was introduced to support 64-bit versions of both Office and Windows (see below on what those differences are). Here are the key changes:
64-bit support, primarily for API
calls. This is both used to make your code work with your OS/Office version as well as others' (i.e. someone on Office 2003/WinXP)
If you are on a 64-bit version of
Windows, but are on a 32-bit version
of Office, you can declare API calls
like below.
.
#If Win64 Then
Declare PtrSafe Function GetTickCount64 Lib "kernel32"() As LongLong
#Else
Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long
#End If
If you are on a 64-bit version of
Windows, and are on a 64-bit version
of Office, you can declare API calls
like:
.
#If VBA7 Then
Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As LongPtr
#Else
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal _
lpClassName As String, ByVal lpWindowName As String) As Long
#End If
To support this, there are:
Three new keywords (2 data types and
1 modifier): LongPtr, LongLong and PtrSafe
One new function: CLngLng() (i.e.
Int64)
The new compilation constants as used
above: VBA7 and Win64
This piece on MSDN has more on the changes in VBA 7 for Office 2010:
http://msdn.microsoft.com/en-us/library/ee691831(loband).aspx#odc_office2010_Compatibility32bit64bit_IntroducingVBA7CodeBase
VBA7 is compatible with 64-bit versions of Office.
There are other changes as well... I'm having users in the field report that code which functioned properly in 2007 no longer works and shows errors.
Example, this works in VBA6 (Excel 2007)
PRINT STRING$(80,"=")
mynewdata = MID$(mydata, 15,4)
It prints out a line made of "=" characters as a visual break, then looks at mydata, jumps over 15 characters and gets 4 of them, the result is stored in mynewdata. It fails in VBA7 (Excel 2010).
I did find a potential workaround...
PRINT VBA.STRING$(80,"=")
mynewdata = VBA.MID$(mydata, 15,4)
OR
PRINT VBA.STRING(80,"=")
mynewdata = VBA.MID(mydata, 15,4)
A complete list of changes would still be helpful... and/or a file converter.
Is there an equivalent to Thread.Sleep() in Access VBA?
Declare Sub Sleep Lib "kernel32" Alias "Sleep" _
(ByVal dwMilliseconds As Long)
Use the following syntax to call the Sleep function:
Sub Sleep()
Sleep 1000 'Implements a 1 second delay
End Sub
Another way without using kernel32:
Dim started As Single: started = Timer
Do: DoEvents: Loop Until Timer - started >= 1
All of the rest of the methods to make Excel wait result in Excel becoming completely unresponsive. The solution to make Excel wait while ensuring a responsive UI is to call this wait Sub with the number of seconds to wait.
Sub Wait(seconds As Integer)
Dim now As Long
now = Timer()
Do
DoEvents
Loop While (Timer < now + seconds)
End Sub
A couple of amendments are required to get the code to work.
The code below is the corrected version.
Declare Sub Sleep Lib "kernel32" Alias "Sleep" (ByVal dwMilliseconds As Long)
Sub SleepVBA()
Sleep 1000 'Implements a 1 second delay
End Sub
I use this in Excel and it works great:
Application.Wait DateAdd("s", 1, Now())
DateAdd() is a function that set a time, relative to Now() (in this case - you can use other values as your argument), "s" is the time measure (seconds in this case), and the increment is 1. So here, the function call is telling the application to wait 1 second.
See also for more detail about the use of the DateAdd function.
If you use Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long), you may get this error in an object module.
If so, you can declare it as private:
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
It is possible to use the Excel Wait() procedure from Access VBA.
The first step is to ensure that the Excel library is referenced from your project.
When that's done the following code will work to wait for ten seconds :
Call Excel.Application.Wait(Time:=DateAdd("s",10,Now()))
Cross-Platform Solution
The accepted answer will not work in 64-bit VBA. Also, it won't work on Mac.
Thanks #Cristian Buse for pointing out Mac compatibility in your comment!
Achieving full Mac compatibility requires importing the platform-dependent library function for suspending thread execution, that is usleep on Mac and Sleep on Windows. Because usleep takes it's argument in microseconds and Sleep uses milliseconds, it is necessary to declare a custom Sub that deals with the conversion.
Importing the library functions and declaring the Sub can be done as presented in the following.
This solution emerged from a collaboration of myself and Cristian Buse on an adaption of his original solution, to avoid integer overflow and to allow Sleep times of more than &HFFFFFFFF microseconds (~71 minutes) on Mac:
#If Mac Then
#If VBA7 Then
Private Declare PtrSafe Sub USleep Lib "/usr/lib/libc.dylib" Alias "usleep" (ByVal dwMicroseconds As Long)
#Else
Private Declare Sub USleep Lib "/usr/lib/libc.dylib" Alias "usleep" (ByVal dwMicroseconds As Long)
#End If
#Else 'Windows
#If VBA7 Then
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#Else
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If
#End If
#If Mac Then
'Sub providing a Sleep API consistent with Windows on Mac (argument in ms)
'Authors: Cristian Buse, https://stackoverflow.com/a/71176040/12287457
' Guido Witt-Dörring, https://stackoverflow.com/a/74262120/12287457
Public Sub Sleep(ByVal dwMilliseconds As Long)
Do While dwMilliseconds And &H80000000
USleep &HFFFFFED8
If dwMilliseconds < (&H418937 Or &H80000000) Then
dwMilliseconds = &H7FBE76C9 + (dwMilliseconds - &H80000000)
Else
dwMilliseconds = dwMilliseconds - &H418937
End If
Loop
Do While dwMilliseconds > &H418937
USleep &HFFFFFED8: dwMilliseconds = dwMilliseconds - &H418937
Loop
If dwMilliseconds > &H20C49B Then
USleep (dwMilliseconds * 500& Or &H80000000) * 2&
Else
USleep dwMilliseconds * 1000&
End If
End Sub
#End If
Now Sleep will be available on both, Windows and Mac and in 32- as well as 64-bit environments.
It can be called like this:
Sub ExampleSleepCall()
Sleep 1000 'Suspends thread execution for 1 second
'Calling application will freeze completely for that amount of time!
'If this is undesired, look here: https://stackoverflow.com/a/74387976/12287457
End Sub
Note that:
While Sleep does take its argument in milliseconds, its resolution is not actually 1 millisecond.
If you want to use Sleep inside of a class module and you don't want to declare the sub in an additional standard module, you can use the above code but you have to replace all occurrences of Public with Private, because it's impossible to import API functions as Public inside a class module.
On Mac, the maximum usleep duration is limited by MAX_UINT = &HFFFFFFFF microseconds or about 4294.97 seconds (~71 minutes). This is why the custom Sleep sub for Mac will call usleep multiple times for input values dwMilliseconds > &H418937, to avoid integer overflow issues.
On Windows (and on Mac with the custom Sleep sub), the maximum Sleep duration is limited by MAX_UINT milliseconds, about 4294967.3 seconds. (~49.71 days)
On both Windows and Mac, calling Sleep with millisecond values greater than MAX_LONG = &H7FFFFFFF (= 2147483647) requires passing it negative VBA Long values, with the maximum Sleep duration achieved by calling it like this: Sleep -1 (=Sleep &HFFFFFFFF)
Note that this way of pausing the execution has severe drawbacks in VBA!
Most importantly, all Microsoft Office applications run VBA code in the same thread as the main user interface. This means, calling Sleep essentially freezes the entire application (It will show as "not responding" in Task-Manager!). There is no way of recovering from this state without waiting for the time to pass or force quitting the Application and restarting it. Excels Application.Wait suffers from the same issue. While the app will not show as not responding in Task Manager in this case, it will be just as unresponsive to the user.
A way to circumvent this problem is calling DoEvents in a loop, as other people have already pointed out. However, this comes with another issue. Because the application will try to execute VBA code as fast as possible, DoEvents is called at the maximum achievable rate essentially saturating the CPU completely on that single thread, leading to high, unnecessary CPU and power usage and potentially slowing down other more important tasks in the UI.
To learn about the best way to pause VBA execution, look at this answer.
Adding
Declare Sub Sleep Lib "kernel32" Alias "Sleep" (ByVal dwMilliseconds As Long)
somehow created additional problems somewhere else in my code.
I ended up using this function that I found on an other forum and tweeked a bit:
Function WaitTime(n As Double)
'Function that wait an amount of time n in seconds
TWait = Time
TWait = DateAdd("s", n, TWait)
Do Until TNow >= TWait
TNow = Time
Loop
End Function
hope this helps :)
If the code is executing in a Form, you can use the built-in Timer of the Form.
Start the timer of the Form with
TimerInterval = 1000 ' Delay in ms
Declare an event handler:
Private Sub Form_Timer()
TimerInterval = 0 ' Stop the timer if don't want to repeat the event each second
' Execute your code here
End Sub