0

我的 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
4

1 回答 1

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
于 2020-10-13T16:53:43.387 回答