Macro Error

[bullcreel]

I have the 4 macros below that I run on a worksheet. Everytime I hit one of the buttons first time, I get an error. I have to delete the popout and then it starts working fine. When I bring up that worksheet up again later, same thing happens.


Sub RunRisk()
'delete previous picture
DeletePicture
'create new picture centrally placed
Application.ScreenUpdating = False
Sheets("Charts").Range("B2:k13").Copy
With ActiveSheet
.Pictures.Paste
With .Shapes(.Shapes.Count)
.Name = "TablePicture"
.OnAction = "DeletePicture"
.Left = (ActiveWindow.VisibleRange.Width - .Width) / 3
.Top = (ActiveWindow.VisibleRange.Height - .Height) / 3
End With
End With
End Sub

Sub DeletePicture()
Dim shp As Shape
For Each shp In ActiveSheet.Shapes
If shp.Name = "TablePicture" Then shp.Delete
Next shp
End Sub

Sub Assist()
'delete previous picture
DeletePicture2
'create new picture centrally placed
Application.ScreenUpdating = False
Sheets("Charts").Range("B15:f20").Copy
With ActiveSheet
.Pictures.Paste
With .Shapes(.Shapes.Count)
.Name = "TablePicture"
.OnAction = "DeletePicture2"
.Left = (ActiveWindow.VisibleRange.Width - .Width) / 3
.Top = (ActiveWindow.VisibleRange.Height - .Height) / 3
End With
End With
End Sub

Sub DeletePicture2()
Dim shp As Shape
For Each shp In ActiveSheet.Shapes
If shp.Name = "TablePicture" Then shp.Delete
Next shp
End Sub


Sub InfieldIn()
'delete previous picture
DeletePicture3
'create new picture centrally placed
Application.ScreenUpdating = False
Sheets("Charts").Range("h15:j19").Copy
With ActiveSheet
.Pictures.Paste
With .Shapes(.Shapes.Count)
.Name = "TablePicture"
.OnAction = "DeletePicture3"
.Left = (ActiveWindow.VisibleRange.Width - .Width) / 2
.Top = (ActiveWindow.VisibleRange.Height - .Height) / 2
End With
End With
End Sub

Sub DeletePicture3()
Dim shp As Shape
For Each shp In ActiveSheet.Shapes
If shp.Name = "TablePicture" Then shp.Delete
Next shp
End Sub


Sub OutfieldIn()
'delete previous picture
DeletePicture4
'create new picture centrally placed
Application.ScreenUpdating = False
Sheets("Charts").Range("h21:j25").Copy
With ActiveSheet
.Pictures.Paste
With .Shapes(.Shapes.Count)
.Name = "TablePicture"
.OnAction = "DeletePicture4"
.Left = (ActiveWindow.VisibleRange.Width - .Width) / 2
.Top = (ActiveWindow.VisibleRange.Height - .Height) / 2
End With
End With
End Sub

Sub DeletePicture4()
Dim shp As Shape
For Each shp In ActiveSheet.Shapes
If shp.Name = "TablePicture" Then shp.Delete
Next shp
End Sub

 

[Dan_W]

Hi. On what line does the error occur, and what does the error message say? Just a guess, but is it on the line: .Pictures.Paste?

 

[bullcreel]

Error message is run-time error 1004...Application-defined or object-defined error.

Depending on the button I push, the ".OnAction ="DeletePicutre4" is highlighted

 

[Dan_W]

Well, this is odd because: (1) I wouldn't have expected the code to break on that line (though I note that you've got a typo in the procedure name, but it's not in the original code, so it doesn't matter); and (2) I tried running your code on my computer, and it worked fine. There were no error messages. So I actually have no idea - sorry.

I would say that, in my personal experience, Excel will almost always throw up errors when I try and copy and paste images (especially across different worksheets), and that appears to be because VBA moves quicker than Excel can actually perform the task. I've read somewhere that this is because of the time it takes the computer to copy and paste things from the clipboard (which is why I suggested that error might happen on the .Picture.Paste line). I tend to find that any problems with copying/pasting can generally be solved by forcing the code to pause slightly between each step of copy/paste. I'm not sure that explains why it would break on that line, but it couldn't hurt to try?

 

[Dan_W]

So I would probably try the following PAUSE subroutine, and I've rewritten one of the subroutines below to include 2 PAUSEs - one between copying and pasting, and one just after pasting. Both pause for one second.

Sub PAUSE(Period As Single)
Dim T As Single
T = Timer
Do
    DoEvents
    Loop Until T + Period < Timer
End Sub

Also, maybe try assigning the separate sheets to variables (as below) and see if that helps?
And in each of the key subs, you could try:

Sub RunRisk()

Dim SourceWS as Worksheet
Dim DestinationWS as Worksheet
Set SourceWS = Application.ActiveWorkbook.Sheets("Charts")
Set DestinationWS = Application.ActiveSheet

'delete previous picture
DeletePicture
'create new picture centrally placed
Application.ScreenUpdating = False
SourceWS.Range("B2:k13").Copy
PAUSE 1
With DestinationWS
    .Pictures.Paste
    PAUSE 1
    With .Shapes(.Shapes.Count)
        .Name = "TablePicture"
        .OnAction = "DeletePicture"
        .Left = (ActiveWindow.VisibleRange.Width - .Width) / 3
        .Top = (ActiveWindow.VisibleRange.Height - .Height) / 3
    End With
End With
End Sub

Let me know if that works. I'm probably missing something obvious; it's just a bit tricky when I can't recreate the problem.... :-/

 

[bullcreel]

Tried your second solution and it is telling me that the first Pause 1 is "Sub or Function not Defined"

 

[Dan_W]

You need both of them in there. The "first solution" is the code that the "second solution" is telling you it can't find.

 

[bullcreel]

the problem seems to be fixed. Thanks. It does take a bit to load the popup. Can I change the pause 1 to say pause .5?

 

[bullcreel]

Nevermind, I went to another workbook entirely, came back to this one and it errored again.

 

[Dan_W]

Ok, so the thing I was doing to the Worksheets was because when you start running code over different worksheets, VBA can get confused about which of them is meant to be the ActiveSheet. The same issue can occur as between workbooks, so with the problem just now, chances are that VBA is confused as to which of the various workbooks you have open is meant to be the ActiveWorkbook. What I guess has just happened (what was the error number and error message?), is that by switching back from another workbook, VBA has just tried to access the Charts worksheet in this other workbook, and I suspect there is no Charts Worksheet there.