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