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