使用Access VBA對子表單進行動畫處理

Question

我試圖通過使用一些動畫打開子窗體來向我的Access數據庫添加一點耀斑。 我希望它從主窗體的左上角打開，並以較小的增量擴展其大小，直到達到主窗體的寬度和高度為止。 我逐步執行該代碼時，它似乎可以按預期工作，但是實際上，它在循環的整個過程中都暫停了，並且僅以完整尺寸顯示表單，而沒有任何動畫外觀。 似乎它是批量運行循環，然后對子窗體對象執行調整。 關於如何實現這一目標的任何建議？

Option Compare Database
Option Explicit

Declare Sub Sleep Lib "kernel32" _
(ByVal dwMilliseconds As Long)

Public Sub AnimateOpenForm(SubForm As String, maxWidth As Long, maxHeight As Long)
    Dim sbf As SubForm
    Dim parentForm As String
    Dim incrementX As Double
    Dim incrementY As Double

    parentForm = "frmHome"

    Set sbf = Forms(parentForm).Controls("sbfPopUp")
    sbf.SourceObject = SubForm

    sbf.Width = 0
    sbf.Height = 0

    sbf.Visible = True

    incrementX = maxWidth / 1000
    incrementY = maxHeight / 1000

    Do While sbf.Width < maxWidth And sbf.Height < maxHeight

        sbf.Width = sbf.Width + incrementX
        sbf.Height = sbf.Height + incrementY

        Sleep 10

    Loop

End Sub

Answer 1

DoEvents將為系統提供所需的重繪暫停時間。

而不是睡眠（並進行32位內核調用），我將您的代碼從“睡眠10”更改為“啟動=計時器：執行：DoEvents：循環運行，直到計時器-開始> = 0.001”並向上調暗了“ Dim啟動為單”導致：

Public Sub AnimateOpenForm(SubForm As String, maxWidth As Long, maxHeight As Long)
    Dim sbf As SubForm
    Dim parentForm As String
    Dim incrementX As Double
    Dim incrementY As Double
    Dim started As Single

    parentForm = "frmHome"

    Set sbf = Forms(parentForm).Controls("sbfPopUp")
    sbf.SourceObject = SubForm

    sbf.Width = 0
    sbf.Height = 0

    sbf.Visible = True

    incrementX = maxWidth / 1000
    incrementY = maxHeight / 1000

    Do While sbf.Width < maxWidth And sbf.Height $lt; maxHeight

        sbf.Width = sbf.Width + incrementX
        sbf.Height = sbf.Height + incrementY

        started = Timer: Do: DoEvents: Loop Until Timer - started >= 0.001

    Loop

End Sub