After MSO shape add, need a Wait before a Pop up, or it comes up after Pop up (XL 2007 2010 - don't need to wait in Excel 2003)
Happy Easter, Eileen’s Lounge :) ;)I have a workaround to this problem that is OK. But I thought I would just ask if anyone knows how to do it properly.
I have a File.
Every day that File is opened by someone.
When they do that, and if they enable macros, then a few Pop ups come up and ask for some information.
I added today a few code lines to:
_ add a shape before a Pop up comes up ,
and to
_ delete it after the Pop up is closed.
But usually the shape will not come up until after the Pop up closes.
( So far I have experienced this in all Excel 2007 and 2010 versions that I have tried ).
The shape is then seen for only a split second just before the code line that deletes it.
( Strangely: if I add a 10 second wait after the Pop up, before the delete code line, then the shape still only comes up for a split second at the end of the 10 second wait, just before the code line that deletes it )
The workaround is to add a 1 second wait before the Pop up comes up.
Below and in the attached File is a code to demo the problem.
If you ‘comment out this code ,line which is just before the Pop up:_..
Code: Select all
If CLng(Val(Application.Version)) <> 11 Then Application.Wait (Now + TimeValue("00:00:01")) ' Worksarounds for Excel 2007, 2010
_.., then typically you will only see the shape for a split second before it is deleted. ( At least that is my experience so far in Excel 2007 and 1010 )
I want the shape to stay up until the Pop up closes.
HappyEasterEileensLounge.JPG : https://imgur.com/dWedCzN" onclick="window.open(this.href);return false; My desires are satisfied within Excel 2007 and 2010 with the inclusion of a short wait before the Pop up, i.e. the inclusion of that code line above. But that seems a “bodge” / workaround to me, so I was wondering if anyone knows how to do it properly .
I tried this out on a few computers and Excel versions. I always seem to need the workaround in Excel 2007 and Excel 2010. I do not seem to need the workaround on any versions of Excel 2003 that I have tried.
This is not a major problem, but I thought I would ask on the off chance that anyone has any ideas to explain this strange behaviour and/ or knows a way to make sure the shape comes up before the Pop up, without my workaround.
Thanks
Alan
Demo Code:
( The main code, Pubic Sub Workbook_Open(), I normally have in in the ThisWorksheet code Modul, so that the code runs when the The Workbook is opened (You can run it from there or any other code module using the other code, Sub CallWorkbook_Open , below ))
Code: Select all
Option Explicit
' This code can go in any code module
Sub CallWorkbook_Open()
Call ThisWorkbook.Workbook_Open
End Sub
'
'
'
' This code needs to go in the ThisWorkbook code module
Public Sub Workbook_Open() ' Bring up a shape before a Pop up box
On Error GoTo Bed
Dim Shp As Shape: Set Shp = Worksheets.Item(1).Shapes.AddShape(msoShapeHeart, 50, 50, 200, 200)
With Shp
.Fill.ForeColor.RGB = RGB(240, 100, 230)
.TextFrame.Characters.Text = "Happy" & vbCrLf & "Easter" & vbCrLf & Format(Date, "dddd") & vbCrLf & "Eileen's Lounge" & vbCrLf & "You secret hidden little Wild thing, you, x ;)"
.TextFrame.HorizontalAlignment = xlHAlignCenter
.TextFrame.Characters.Font.Color = vbWhite
If CLng(Val(Application.Version)) = 11 Then ' Excel 2003
.TextFrame.Characters.Font.Size = 15
.TextFrame.Characters(8, 6).Font.Color = vbYellow
.TextFrame.Characters(8, 6).Font.Size = 26
Else ' Excel 2007 and Excel 2010 as far as I know
.TextFrame.Characters.Font.Size = 14
.TextFrame.Characters(7, 6).Font.Color = vbYellow
.TextFrame.Characters(7, 6).Font.Size = 20
End If
End With
' DoEvents ' --- This line didn't have any effect on the problem
If CLng(Val(Application.Version)) <> 11 Then Application.Wait (Now + TimeValue("00:00:01")) ' Worksarounds for Excel 2007, 2010
Dim strDte As String: Let strDte = VBA.InputBox(Prompt:="Date of pro", Title:="Give date to add to Filename", Default:=Replace((Format(Date, "dddd dd mmmm dd mm yyyy")), "ä", "ae", 1, 1, vbBinaryCompare))
' Application.Wait (Now + TimeValue("00:00:10")) ' Strangely: With this the shape is only there for a split second after the 10 second wait
Shp.Delete
Exit Sub
Bed:
MsgBox Prompt:=Err.Number & vbCrLf & Err.Description
If Worksheets.Item(1).Shapes.Count = 1 Then Shp.Delete
Application.EnableEvents = True: Application.Calculation = xlCalculationAutomatic: Application.ScreenUpdating = True
End Sub