Sub Sample5()
    Dim TotalSize As Long, buf As String
    UserForm1.Show vbModeless
    UserForm1.Repaint
    ''ここから時間のかかる処理
    buf = Dir("C:\Windows\System32\*.*")
    Do While buf <> ""
        TotalSize = TotalSize + FileLen("C:\Windows\System32\" & buf)
        buf = Dir()
    Loop
    Unload UserForm1
End Sub

Dim flag As Boolean
Private Sub CommandButton1_Click()
    If MsgBox("中止しますか?", 292) = vbYes Then flag = True
End Sub
Private Sub UserForm_Activate()
    Dim TotalSize As Long, buf As String
    Me.Repaint
    ''ここから時間のかかる処理
    buf = Dir("C:\Windows\System32\*.*")
    Do While buf <> ""
        DoEvents
        If flag = True Then Exit Do
        TotalSize = TotalSize + FileLen("C:\Windows\System32\" & buf)
        buf = Dir()
    Loop
    Unload Me
End Sub
UserFormを使ったメッセージ(Excel 2000以降)
Tagged on: