VBA api创建进度条

Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwE As Long, ByVal lpC As String, ByVal lpW As String, ByVal dwS As Long, ByVal x As Long, ByVal y As Long, ByVal nW As Long, ByVal nH As Long, ByVal hW As Long, ByVal hM As Long, ByVal hI As Long, lpP As Any) As Long
Private Const WS_CHILD = &H40000000
Private Const WS_VISIBLE = &H10000000
Private Const PBM_SETPOS = &H402
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wP As Long, lP As Any) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMs As Long)
Private Const WM_SETTEXT = &HC
Dim hwndPro As Long
Private Declare Sub InitCommonControls Lib "comctl32" ()
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Sub UserForm_Click()
Dim hwnd&
hwnd = FindWindow("ThunderDFrame", Me.Caption) '获取窗口句柄
    Dim i As Integer
    hwndPro = CreateWindowEx(0, "msctls_progress32", "", WS_VISIBLE Or WS_CHILD, 10, 10, 200, 20, hwnd, 0&, Application.Hinstance, 0&)

    For i = 0 To 100
        Sleep 20: DoEvents
        SendMessage hwndPro, PBM_SETPOS, i, 0
        SendMessage hwnd, WM_SETTEXT, 0, ByVal CStr(i & "%")
    Next
End Sub

Private Sub UserForm_Initialize()
 InitCommonControls

End Sub

转载于:https://www.cnblogs.com/yuzhengdong/p/3707770.html