White Tiger

Microsoft Excel VBA - ユーザーフォームに進行状況を表示する方法（API使用）

◆概要
　ProgressBarコントロールを使用すると、簡単にユーザーフォームに進行状況を表示することができますが、次のようにAPIを使うとProgressBarコントロールを使用せずに、ユーザーフォームに進行状況を表示することができます。
　フォームにコマンドボタンを１つ配置して、フォーム内のコードに次のコードを記述してください。

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function CreateWindowEX Lib "user32" _
Alias "CreateWindowExA" (ByVal dwExStyle As Long, _
ByVal lpClassName As String, ByVal lpWindowName As String, _
ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, _
ByVal nWidth As Long, ByVal nHeight As Long, _
ByVal hWndParent As Long, ByVal hMenu As Long, _
ByVal hInstance As Long, lpParam As Any) As Long
Private Declare Function DestroyWindow Lib "user32" _
(ByVal hwnd As Long) As Long
Private Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, lParam As Any) As Long

Private Sub CommandButton1_Click()
    Me.CommandButton1.Enabled = False
    Me.Repaint
    Dim y&, W&, mehWnd&, pbhWnd&, i&
    mehWnd = FindWindow(vbNullString, Me.Caption)
    W = Me.InsideWidth * 4 / 3
    y = (Me.InsideHeight - 15) * 4 / 3
    pbhWnd = CreateWindowEX(0, "msctls_progress32", "" _
    , &H50000000, 0, y, W, 20, mehWnd, 0&, 0, 0&)
    SendMessage pbhWnd, &H409, 0, ByVal RGB(0, 125, 0)
    For i = 1 To 50000
        DoEvents
        SendMessage pbhWnd, &H402, CInt(100 * i / 50000), 0
    Next i
    DestroyWindow pbhWnd
    Me.CommandButton1.Enabled = True
End Sub

次に、標準モジュールを追加して、以下のコードを記述し実行します。

Sub test()
    UserForm1.Show
End Sub

◆実行結果

Link