Excel VBA 弹出形状

Question

我的 Excel 应用程序在加载和保存文件时需要一个弹出屏幕。 我创建了一个宏，如下所示以弹出一个形状。 最初，oShape.Top 位置是 300，在当前屏幕下方。

我已经尝试了宏的所有组合，但无法在当前屏幕上看到这个椭圆形。 奇怪的是，如果我在这个宏的最后一个“DoEvents”上创建一个调试切换断点，弹出窗口将是可见的。

任何援助将不胜感激。 宏如下：

Public Sub TestUP()
    Dim oShape As Shape
    Set oShape = ActiveSheet.Shape("Oal42")
    Application.ScreenUpdating = True
    DoEvents
    NextTime = Now + TimeValue("00:00:05")
    oShape.Visible = True
    oShape.Top = 80
    DoEvents
    NextTime = Now + TimeValue("00"00"05")
    DoEvents
End Sub

Answer 1

您的主要问题是形状在您显示它的那一刻没有重新绘制，并且在您发出DoEvent时它似乎甚至没有重新绘制。 对于用户窗体，有一个Repaint方法可以强制 VBA 重新显示它，但不适用于工作表或形状。

但是，有一些技巧可以做到这一点。 这个答案显示了 3 种可能的黑客攻击。 我尝试了Application.WindowState = Application.WindowState并且它对我有用。 以下代码给出了如何使用它的示例 - 您可以在运行时修改文本。

Option Explicit
Const ShapeName = "Oal42"

Public Sub ShowMsg(msg As String)
    With ActiveSheet.Shapes(ShapeName)

        If .TextFrame2.TextRange.Characters <> msg Then
            .TextFrame2.TextRange.Delete
            .TextFrame2.TextRange.Characters = msg
        End If
          
        .Visible = True
        .Top = 80
        DoEvents
        Application.WindowState = Application.WindowState
    End With
End Sub

Public Sub HideMsg()
    ActiveSheet.Shapes(ShapeName).Visible = False
End Sub

这显示了用法：

Sub testSub()
    ShowMsg "Start"
    Dim i As Long
    For i = 1 To 100 Step 8
        ShowMsg "Working, " & i & "%  done."
        Application.Wait Now + TimeSerial(0, 0, 1)
    Next i
    HideMsg 
End Sub