I'm building a process to convert linked images into embedded images in Excel:
for ws in wb.sheets
count = ws.shapes.count
for 1 to count
'Get first shape from collection
set shp = ws.shapes(1)
'Store shape's position/size
'...
'Break link if it exists
shp.CopyPicture
ws.Paste
shp.delete
set newShp = ws.shapes(count)
'Assign newShp, shp's old position/size
'...
next shp
next ws
Sometimes the code will error on line the 2nd line of:
shp.CopyPicture
ws.Paste
with the error "Unable to execute method paste...". This occurs also when I space out the copy and paste methods with DoEvents like so:
shp.CopyPicture
DoEvents
ws.Paste
DoEvents
However after clicking debug, and waiting a second or two, and pressing play again everything continues working like a charm.
I suspect Excel isn't waiting long enough for the CopyPicture method, to fully occupy the clipboard. Assuming this is the case, can I monitor the clipboard somehow and wait till the clipboard data is full?
I think you probably just need to add a pause to give the clipboard a moment to populate the clipboard before you try to access it.
I use a pause procedure like:
Sub Pause(sec as Single)
Dim startTime as Single
StartTime=Timer
Do
DoEvents
Loop While StartTime + sec > Timer
End Sub
I'd probably start with a quarter or half second pause (ie., Pause (0.25)) and then loop until the clipboard's ready.
A half second should be more than enough time, although ideally you'd be triggering your procedure from the other end after pasting, proactively instead of re actively.
I was searching something similar (proper syntax on API calls for the clipboard), and came across this thread. It may be worth noting that when you send data to the clipboard, it indeed takes time.
The "Do events while busy" I used to use came to mind when using my old IE.navigate commands.
Anyway, what do you think of this.
SendKeys ("^c") 'Psudeocode to copy
JumpPoint:
RandomVar = Clipboard.GetData
DoEvents 'Force this data into a random address somwhere while Clipboard loads
If ClipBoard.GetData <> RandomVar Goto JumpPoint
[Do the Magic here]
See that? If RandomVar = the current state of the ClipBoard, and Do Events makes it so that RandomVar is equal to SOMETHING referencable, then as ClipBoard continues to aggregate data, it will differ from RandomVar. Thus the Goto will kick back a tick, essentially "Do Events While Busy".
That's just my thought process using the tools you already have available without seeing the entire code or intention.
Yes, my coding methods are blasphemy. I don't care. Good luck, and my the dark side be ever with you.
It's been a while since I asked this question. Since then my knowledge has grew in this arena. In the future I'll use my stdClipboard class's xlShapeAsPicture method as follows:
for ws in wb.sheets
count = ws.shapes.count
for 1 to count
'Get first shape from collection
set shp = ws.shapes(1)
'Store shape's position/size
'...
'Break link if it exists
set stdClipboard.xlShapeAsPicture = shp '<<<---
'Paste
ws.Paste
'...
next shp
next ws
The key to this solution is making calls to poll IsFormatAvailable() after shp.CopyPicture() is called to wait until the image format is available, and only then exit the function and continue runtime.
Related
I have an application with some charts and many comboboxes (activex control).
When the user changes the value of any combobox the charts are updated. No problem here.
So, I made a code to export the whole screen of the app as image. This is used to simulate several scenarios.
But, here is where the problem begins.
There are some "for...next" loops in this code to change the values of these comboboxes. When the images are exported, the charts are updated as expected, but the comboboxes DO NOT change their values. They show the same value on every scenario, even that the charts are being updated.
So, the question is: Is there a way to refresh the value of a combobox before the code is ended?
Sub example()
For Each elem In myArray
Sheets("App").ComboBox1.Value = elem
Sheets("Temp").Shapes.AddChart
Set cht = Sheets("Temp").ChartObjects(1)
Sheets("App").Range("A1:AM103").CopyPicture Appearance:=xlScreen, Format:=xlBitmap
With cht.Chart
.Paste
.export Filename:="test.jpg", FilterName:="jpg"
.Parent.Delete
End With
Next
End Sub
Explanation
First of all, congratulations: you've found a very annoying bug here.
I've tried to reproduce your issue, and I can do it very easily.
If you set a breakpoint after updating the combobox (i.e. the thread is paused) => the ActiveX component is refreshed
If you set an Application.Wait (TimeSerial(Hour(Now()), Minute(Now()), Second(Now()) + 5)) (i.e. you visually stop the execution for 5 seconds, but technically speaking the thread is still running) => you can clearly see the ActiveX component not getting updated, and that's why your image is generated wrongly.
I've tried all the obvious tricks (Application.ScreenUpdating = True, DoEvents, Application.EnableEvents = True, Application.Calculate etc.) but no success in any case.
It really seems that ActiveX components will get refreshed by Microsoft Excel only when the VBA thread ends. Wow.
The only way around this bug that I can think of
The only way I can think of to technically stop the execution after updating the ActiveX component, and resume it later, is to use the Application.OnTime method of Excel:
Application.OnTime schedules a procedure to be run at a specified time in the future (either at a specific time of day or after a specific amount of time has passed).
For how ugly it can look from a technical point of view, you could update your combobox and then schedule the rest of your code to happen a second after you did it. From a technical point of view:
VBA thread 1: updates your ComboBox and ends => the ActiveX component gets refreshed
1 second pause without VBA threads.
VBA thread 2: creates the chart and export the image using the updated ActiveX component.
Practically, your code would look something like this:
Dim myArray(2) 'declare your array as global so that it can be accessed by all the macros - in my example I assume it contains 3 elements
Dim currentElem As Integer 'declare this index as global so it remains in memory even after the code ended execution
Sub example()
'call this macro.
'you first initialize your values:
myArray(0) = "test 1"
myArray(1) = "test 2"
myArray(2) = "test 3"
currentElem = 0
'and then call the first update of your activeX component
first_step_set_activeX
End Sub
Sub first_step_set_activeX()
If currentElem < UBound(myArray) Then
'for each element not treated yet
'(that's why the If currentElem < UBound(myArray)
elem = myArray(currentElem) 'get current element from array
Sheets("App").ComboBox1.Value = elem 'update your ActiveX component
currentElem = currentElem + 1 'increase the currentElem index
Application.OnTime TimeSerial(Hour(Now()), Minute(Now()), Second(Now()) + 1), "second_step_make_chart_and_print" 'schedule the call of the printing part
End If
End Sub
Sub second_step_make_chart_and_print()
'here do the job of the printing part
Sheets("Temp").Shapes.AddChart
Set cht = Sheets("Temp").ChartObjects(1)
Sheets("App").Range("A1:AM103").CopyPicture Appearance:=xlScreen, Format:=xlBitmap
With cht.Chart
.Paste
.Export Filename:="test.jpg", FilterName:="jpg"
.Parent.Delete
End With
'and reschedule the call for the next activeX component
Application.OnTime TimeSerial(Hour(Now()), Minute(Now()), Second(Now()) + 1), "first_step_set_activeX"
End Sub
I am attempting to create a macro which opens up a file refreshs a query and will then save and close. Currently the macro initiates the refresh however it moves on to the Save and close command before it has finished and therefore nothing changes. I have seen that there are ways off 'pausing' or 'sleeping' for a period of time to allow the command to be completed however I wish to expand this macro to opening multiple workbooks with queries which take differing times to refresh so therefore that would be a last resort. What I have currently utilizes DoEvents however this doesn't seem to be working either.
Note: The refresh works through SAP Bex analyser 7.
My code:
Sub OpenAndRefresh()
Workbooks.Open "QueryRefresh.xls", UpdateLinks:=False
Workbooks("QueryRefresh.xls").Activate
Run "BExAnalyzer.XLA!SAPBEXrefresh", True
DoEvents
Workbooks("QueryRefresh.xls").Close SaveChanges:=False
End Sub
Any help or guidance would be greatly appreciated.
I have a macro for this purpose, and I've never had this issue:
Public Sub Refresh_All()
Dim filepathstr As String
Dim filename As String
Dim wbk As Workbook
filepathstr = Sheet1.Range("filepath").Value
For Each cell In Sheet1.Range("workbooks")
If Not cell.Value = "" Then
filename = cell.Value
Set wbk = Workbooks.Open(filepathstr & filename)
''''**REFRESH**''''''
SAPBexrefresh (True)
Application.DisplayAlerts = False
wbk.Save
wbk.Close False
Application.DisplayAlerts = True
End If
Next cell
End Sub
The main difference here code-wise is that I'm calling the refresh macro directly rather than using the Run command.
EDIT: To make this work you also need to add the "BExAnalyzer" Reference in your project. If you're not familiar with adding references, you need to go into Tools --> References, then click on "BExAnalyzer" out of the long list of available references.
I'm not sure why this would make any difference but as I say, I've always found that my macro finishes refreshing (even when this takes up to 15 minutes) before continuing. I'm also using BEx 7
Hi I am using the following code to parsing some data from website to excel , I need to create a routine in order to update /Refresh the data and keep is up to date and I been advice to start new topic , is big list with multiple sheets so take long time every time excel has to calculate , I hope someone can may help me out
Public Function giveMeValue(ByVal link As Variant) As Variant
Set htm = CreateObject("htmlFile")
With CreateObject("msxml2.xmlhttp")
.Open "GET", link, False
.send
htm.body.innerhtml = .responsetext
End With
If Not htm.getelementbyId("JS_topStoreCount") Is Nothing Then
giveMeValue = htm.getelementbyId("JS_topStoreCount").innerText
Else
giveMeValue = "0"
End If
htm.Close
Set htm = Nothing
End Function
to retrive the value I use =GiveMeValue(A1) and condition formatting the returned value I use the Following code :
Dim color As Integer 'Start Color range
For Each cell In Sheets(1).Range("M4:M5000")
If IsEmpty(cell) Then GoTo nextcell:
If Not IsNumeric(cell.Value) Then GoTo nextcell:
If cell.Value > 14 Then
color = 4
ElseIf cell.Value < 8 Then color = 3
Else: color = 6
End If
cell.Interior.ColorIndex = color
nextcell:
Next cell
End Sub
so as I am not skilled at all with VBA I may unappropriate use the following code to try get refresh it but without result:
Sub Refresh()
Dim WAIT As Double
WAIT = Timer
While Timer < WAIT + 10
DoEvents 'do nothing'
ActiveWorkbook.RefreshAll
Wend
MsgBox "Update Finished Successfully !"
'End Sub
Sounds ambitious. I like it! :)
For a start can you just use conditional formatting? Will be a lot quicker than looping through every cell and changing colour.
Secondly, make your GiveMeValue function "volatile" (http://www.excel-easy.com/vba/examples/volatile-functions.html) so that it refreshes every time you recalculate the page i.e. add a line "application.volatile(true) before anything else in the function.
Thirdly: run your refresh code in the "worksheet_calculate" event and change it to:
Sub Refresh()
Dim WAIT As Double
WAIT = Timer
While Timer < WAIT + 10
DoEvents 'do nothing'
Wend
wsSheet.Calculate
End Sub
So it runs... waits a bit... calculates, then that calculation triggers another wait... etc... Now that your function is volatile, it should refresh all the "getvalue" formulas you have on the current sheet...
And I guess forthly put a "wsSheet.calculate" in the worksheet_activate event to trigger start of that endless loop...
Having said all that, perhaps that endless loop will cause huge issues i.e. mega computer slow down, inability to use computer, and general doom... only one way to find out! The doevents thing should in theory make everything OK. Maybe add if activesheet.codename = "wsSheet" then... so its only running when you're on that sheet...
While Navigating my sheet I use the F5+[enter] to navigate back to the cell that I hyperlinked from on a different sheet in the same workbook.
I have now made an Activex button to act as a back button but I need the script to make it do an F5+[enter] when clicked on.
I have lots of hyperlinks from different areas that go to one specific sheet and I basically want the Activex button to return the cursor back from whence it came.
Any help would be appreciated
Thank you
*****Sorry My fault I meant Active X Button*****
Edited and re tagged. Much appreciated
Since application.goto function stores the last reference as default you can simply bind a key for the following command
Application.Goto
This is not the perfect solution but it will do what you want. All you need to do is add this line to button_click.
As a general note, mimicking the actions of the keyboard through VBA involves using the Application.SendKeys command. In your specific case, the code would be:
Application.SendKeys "{F5}"
Application.Wait (Now + TimeValue("00:00:01"))
Application.SendKeys "~" 'The tilde is the Enter key
Generally, I prefer not to use this methodology. On my computer, for example, the third line of code runs before the first line has completed its action. In that case, I'm sitting with the Go To dialog box on my screen. That's why I separate the two lines with a call for the system to delay processing.
EDIT: (I think I cut off part of my original post)
In my opinion, your best bet is to allow Excel to handle the flow back to the hyperlink cells. The also opens up the possibility to move back beyond just the last cell. Below is a loose example of the code, which should be adapted.
In a module, enter the below code:
Public strLastSheet(1 To 10) As Worksheet
Public strLastRange(1 To 10) As Range
Public nLastCell As Integer
Public nCurrentIndex As Integer
Sub SelectLastHyperlinkedCellFoShizzle()
strLastSheet(nCurrentIndex).Activate
strLastRange(nCurrentIndex).Select
If nCurrentIndex <= 1 Then
'Do Nothing
Else
nCurrentIndex = nCurrentIndex - 1
End If
End Sub
In the ThisWorkbook code, enter the following:
Private Sub Workbook_Open()
nLastCell = 0
nCurrentIndex = 0
End Sub
Private Sub Workbook_SheetFollowHyperlink(ByVal Sh As Object, ByVal Target As Hyperlink)
nLastCell = nLastCell + 1
Set strLastSheet(nLastCell) = Sh
Set strLastRange(nLastCell) = Target.Parent
nCurrentIndex = nLastCell
End Sub
This is set to store the previous 10 hyperlink addresses. It should be further modified to disallow entries beyond 10 into the array, and perhaps shift the previous entries down the array.
Hopefully this is an easy one. I have a series of charts in MS Excel that point to data on the same worksheet. The data on the worksheet is calculated using a VBA function. When the data is updated by the VBA function the new numbers are not reflected in the charts that are pointing to them. I tried calling Application.Calculate, but that didn't do the trick. Any thoughts?
UDPATE:
I was able to duplicate this issue on a much smaller scale. Here's how:
Create a new workbook
Rename Sheet 1 to "Summary"
Rename Sheet 2 to "Data"
Open the Summary sheet in the VBA editor and paste the following code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Parent.Range("worksheetDate") = Target Then
Application.CalculateFull
End If
End Sub
Create a new VBA module
Paste the following code into the new VBA module (I apologize - I can't get Stack Overflow to format this correctly for the life of me - this is the best I could get it to do):
.
Function getWeekValue (weekNumber As Integer, valuesRange As Range) As Integer
Dim aCell As Range
Dim currentDate As Date
Dim arrayIndex As Integer
Dim weekValues(1 To 6) As Integer
currentDate = ThisWorkbook.Names("worksheetDate").RefersToRange.Value
arrayIndex = 1
For Each aCell In valuesRange
If month(currentDate) = month(ThisWorkbook.Sheets("Data").Cells( _
aCell.Row - 1, aCell.Column)) Then
weekValues(arrayIndex) = aCell.Value
arrayIndex = arrayIndex + 1
End If
Next
getWeekValue = weekValues(weekNumber)
End Function
.
Modify the Data worksheet to match the following image:
Select Cell B1 and name the range "worksheetDate"
Duplicate rows 1 through 3 in the following image:
In row 4, under the "Week X" headers, enter the following formula
.
= getWeekValue(1, Data!$A$2:$M$2)
incrementing the first argument to the getWeekValue function by one for each week (e.g., pass 1 for Week 1, 2 for Week 2, 3, for Week 3, etc.
Create a bar graph using cells A3 through E4 as the data
Change the date in cell B2 to a date between 10/1/2010 and 12/31/2010, choosing a month other than the month that is currently in the cell. For example, if the date is 12/11/2010, change it to something like 11/11/2010 or 10/11/2010. Note that both the data and chart update correctly.
Modify the date in cell B2 gain. Note that the data updates, but the chart does not.
Oddly, after a period of time (several minutes) has elapsed, the chart finally updates. I'm not sure if this is because I have been performing other activities that triggered the update or because Excel is triggering an update after several minutes.
Just figured out the solution to this issue as I was suffering from the same.
I've just added "DoEvents()" prior to printing or exporting and the chart got refreshed.
example
Sub a()
Dim w As Worksheet
Dim a
Set w = Worksheets(1)
For Each a In w.Range("a1:a5")
a.Value = a.Value + 1
Next
DoEvents
End Sub
at the end of my changes I close the workbook and reopen it. that seems the easiest and most reliable way to update everything for me.
For example:
Sub a()
Dim w As Worksheet
Dim a
Set w = Worksheets(1)
For Each a In w.Range("a1:a5")
a.Value = a.Value + 1
Next
w.ChartObjects(1).Chart.Refresh
End Sub
This solution worked for me. For the offending worksheet add:
Private Sub Worksheet_Activate()
Dim rngSelection As Range
Dim objChartObject As ChartObject
Dim objChart As Chart
Dim objSeriesCollection As SeriesCollection
Dim objSeries As Series
Dim strFormula As String
Set rngSelection = Selection
For Each objChartObject In Me.ChartObjects
Set objChart = objChartObject.Chart
Set objSeriesCollection = objChart.SeriesCollection
For Each objSeries In objSeriesCollection
strFormula = objSeries.Formula
objSeries.Delete
Set objSeries = objSeriesCollection.NewSeries
objSeries.Formula = strFormula
Next objSeries
Next objChartObject
rngSelection.Select
End Sub
It's possible that the issue is the argument list of getWeekValue, which includes only the week number and the data stream.
If you add a third argument, worksheetDate, then Excel's recalculation engine will be hit on the side of the head with the fact that getWeekValue uses the value held in worksheetDate. In your current implementation, this fact is held only in the VBA code, where it is probably invisible to the recalculation engine.
I write this so hedgingly because I am not privy to the inner workings of the recalculation engine. (Maybe someone who knows about this better than I can comment on my speculation) But I did do a test, in which getWeekValue does have that third argument, and the chart does recalculate properly. Nice added benefit of this approach: you can remove all that other VBA event management. -HTH
I've found that calling this Sub works...
Sub DoAllEvents()
DoEvents
DoEvents
End Sub
BUT
Microsoft cautions about being caught with the next DoEvents executing before the first DoEvents completes, which can happen depending on how often it's called without a delay between calls. Thus DoEvents appears to be acting as a type of non maskable interrupt, and nesting non maskable interrupts can cause the machine to freeze for multiple reasons without any recovery other than reboot.
(Note: If one is not calling the routine above, often and quickly, nesting may not
be an issue.)
Using the following Sub below, which I modified from their suggestion, prevents this from happening.
Sub DoAllEvents()
On Error GoTo ErrorCheck
Dim i
For i = 1 To 4000 ' Start loop. Can be higher, MS sample shows 150000
'I've found twice is enough, but only increased it to four or 4000.
If i Mod 1000 = 0 Then ' If loop has repeated 1000 times.
DoEvents ' Yield to operating system.
End If
Next i
Exit Sub
ErrorCheck:
Debug.Print "Error: "; Error, Err
Resume Next
End Sub
I appears that the number of DoEvents needed is based on the number of background tasks running on your machine, and updating the graph appears to be a background task for the application. I only needed two DoEvents because I call the routine frequently; however, I may end up upping it later if needed.
I also keep the Mod at 1000 so to not change the lag between each DoEvents as Microsoft suggests, preventing nesting. One possible reason you might want to increase the number from 2000 to a higher number is if you system does not update the graph. Increasing this number allows the machine to handle larger numbers of background events that DoEvents might encounter through multiple calls as they are probably on a stack, and the DoEvents event is only allowed to run a specific number of cycles before marking its place in the stack to allow unhandled events and returning, leaving them to be handled on the next call. Thus the need for multiple calls. Changing this to their example of 150000 doesn't appear to slow the machine too much, to play it safe you might want to make it 150000.
Note: the first example Sub with two DoEvents is probably safe depending on how often you call the Sub, however, if called too often, your machine might freeze up. Your call. ;-)
PS: DoEvents will become one of your best calls if you create a lot of nested loops and the program doesn't behave as expected. Fortunately, this is available in all apps that use VBA!
Running Excel 2019.
Added the following to the macro code:
ActiveSheet.ChartObjects(1).Chart.Refresh
DoEvents
The chart now updates during macro execution
UDF getWeekValue has to be marked as volatile.
Function getWeekValue (weekNumber As Integer, valuesRange As Range) As Integer
Application.Volatile '!!
Dim aCell As Range
Dim currentDate As Date
'...
Just an idea: in your Worksheet_Change Sub, insert as the first line:
Application.EnableEvents = False
in order to avoid self-firing events....
Of course set it back to True at the end of the Sub.