Excel 在屏幕上绘制图形落后于其他代码

Excel 在屏幕上绘制图形落后于其他代码,excel,vba,Excel,Vba,我正试图为我的一个Excel应用程序创建一个小教程,我遇到了一个问题,我正试图在屏幕上绘制一个文本形状,以便就如何输入InputBox给出建议,但是InputBox会显示在文本形状之前,在调试模式下运行并单步执行代码时,一切正常 有一个userformufNext,它只包含一个按钮,ufNext。此按钮的单击事件代码包含一个Select Case子句,用于确定每次单击时要执行的操作。子句正在检查的值是一个Public变量,tutSectionsRun Option Explicit Priva

我正试图为我的一个Excel应用程序创建一个小教程,我遇到了一个问题,我正试图在屏幕上绘制一个文本形状,以便就如何输入
InputBox
给出建议,但是
InputBox
会显示在文本形状之前,在调试模式下运行并单步执行代码时,一切正常

有一个userform
ufNext
,它只包含一个按钮,
ufNext
。此按钮的单击事件代码包含一个
Select Case
子句,用于确定每次单击时要执行的操作。子句正在检查的值是一个
Public
变量,
tutSectionsRun

Option Explicit

Private Sub btnNext_Click()

    Select Case tutSectionsRun
    Case 1
        Call Section2
    Case 2
        Call Section3
        Call MPFilterString
'   Case N
'       ...
    End Select

End Sub
代码从
Section1
开始,它只设置
ufNext
的位置,并显示表单,然后将全局变量
tutSectionsRun
设置为
1

用户单击
ufNext
表单上的“Next”按钮,调用
Section2
,重新定位表单(这些“Section”过程中通常会有其他代码),并将全局变量设置为
2

同样,用户单击“下一步”按钮,但这一次出现了一个问题,即在将形状绘制到屏幕之前,我会首先弹出
InputBox
,只有在它关闭后,文本形状
tutText
才会绘制到屏幕上

Option Explicit

Public tutSectionsRun As Long

Sub Section1()

    ufNext.Left = 550
    ufNext.Top = 450
    ufNext.Show

    tutSectionsRun = 1

End Sub

Sub Section2()

    ufNext.Left = 910
    ufNext.Top = 350

    tutSectionsRun = 2

End Sub

Sub Section3()

    Dim tutText As Shape

    Set tutText = ActiveSheet.Shapes.AddLabel(msoTextOrientationHorizontal, 600, 300, 200, 100)
    tutText.TextFrame2.TextRange.Text = "Enter the string ""gr"" into the input box."
    tutText.Locked = False

    ufNext.Hide

    tutSectionsRun = 3

End Sub

Sub MPFilterString()

    Dim s As Variant

    Application.ScreenUpdating = False

    s = Application.InputBox("Enter string to filter out.", "Filter String.")

    If s = False Then Exit Sub

End Sub

**编辑:我忘了提到userform是非模态的。否则,调用
ufNext时执行将暂停。Show
并单击next将在
tutSectionsRun
变量设置为
1
之前调用事件处理程序,这要感谢@BrakNicku在评论中证实了我的怀疑,说明
InputBox
阻止刷新屏幕以显示
ActiveSheet.Shapes.AddLabel
中的文本形状

他们的链接提供了一些建议

我发现,在调用
InputBox
之前添加其中任何一个都会强制屏幕刷新,但只有
Application.screenUpdatement=False
被删除,或者至少只是在代码中向下移动了一步

- ActiveSheet.Calculate    
- ActiveWindow.SmallScroll    
- Application.WindowState = Application.WindowState
我总是喜欢在程序的顶部调用
Application.screenUpdate=False
,因此我采用了另一种方法,认为问题在于使用绘制的形状刷新屏幕的时间要比这样做的指令与将
输入框
绘制到屏幕的指令之间的时间长。因此,我认为在调用
InputBox
之前稍微延迟一下可能对我来说是一个更好的选择,可能不是对所有人都是这样,但我觉得这样做更好。(
Application.ScreenUpdate=False
是我的一个好朋友,我不想看到她离开,甚至不想被重新安置),所以我只是做了一个小的等待过程

Sub Wait(secs As Single)

    Dim finishTime As Single

    finishTime = Timer + secs

    Do While Timer < finishTime
        DoEvents
    Loop

End Sub

感谢@BrakNicku,他在评论中证实了我的怀疑,说
输入框
阻止了屏幕刷新以显示
ActiveSheet.Shapes.AddLabel
中的文本形状

他们的链接提供了一些建议

我发现,在调用
InputBox
之前添加其中任何一个都会强制屏幕刷新,但只有
Application.screenUpdatement=False
被删除,或者至少只是在代码中向下移动了一步

- ActiveSheet.Calculate    
- ActiveWindow.SmallScroll    
- Application.WindowState = Application.WindowState
我总是喜欢在程序的顶部调用
Application.screenUpdate=False
,因此我采用了另一种方法,认为问题在于使用绘制的形状刷新屏幕的时间要比这样做的指令与将
输入框
绘制到屏幕的指令之间的时间长。因此,我认为在调用
InputBox
之前稍微延迟一下可能对我来说是一个更好的选择,可能不是对所有人都是这样,但我觉得这样做更好。(
Application.ScreenUpdate=False
是我的一个好朋友,我不想看到她离开,甚至不想被重新安置),所以我只是做了一个小的等待过程

Sub Wait(secs As Single)

    Dim finishTime As Single

    finishTime = Timer + secs

    Do While Timer < finishTime
        DoEvents
    Loop

End Sub

有多少地方有“Application.screenUpdate=False”?这是一个bug(不是没有添加形状,只是inputbox阻止了屏幕刷新)。即使没有
Application.ScreenUpdate=False
,它也无法工作。有一些变通办法。在这种情况下,至少有两个(第一个和第三个)可以工作。我的另一个解决方法是在输入框之前添加
DoEvents
(两次…)。@BrakNicku谢谢。我还没有机会尝试这个,必须等到我周一回去工作(我在澳大利亚,周五晚上大约20:45)。但我相信你在这一点上是正确的。开车回家时,我突然想到我经常使用
Application.Calculation=xlCalculationManual
Application.screenUpdate=False
来提高性能,我想我应该在这里使用它,并在我希望用户看到更改的地方调用
ActiveSheet.Calculation
。很高兴看到一些东西验证了我的想法。@BrakNicku我在家里根据粘贴在这里的内容重新创建了它,正如你所说的,我已经知道,仅仅删除
Application.ScreenUpdate=False
并没有什么区别。但这三个建议的解决办法都不单独起作用。但是,它们都与删除
Application.screenUpdatement=False
一起工作。通过单击事件-创建形状,显示输入框中的一个按钮和两行代码,可以轻松创建无模式问题表单。是的-当你想刷新时禁用sceen更新是一个错误的选择:)。你在多少地方有'Application.ScreenUpdate=False'?这是一个错误(不是没有添加形状,只是inputbox阻止了屏幕显示)