VB用windows API激活子窗体

http://files.cnblogs.com/files/liuzhaoyzz/%E6%BF%80%E6%B4%BB%E5%AD%90%E7%AA%97%E4%BD%93.rar

setforegroundwindow只能激活桌面级的父窗体，即使后面跟的hwnd是子窗体的hwnd也不行！

激活子窗体，可以先用setforegroundwindow把父窗体带到前台，然后用以下消息激活子窗体：

'Private Const WM_MOUSEACTIVATE=&H21

SendMessage thwnd, WM_MOUSEACTIVATE, 0, 0

'Private Const WM_LBUTTONDOWN = &H201

SendMessage tHwnd, WM_LBUTTONDOWN, 0, 0

或者直接用SendMessage thwnd, 33, 0, 0来激活子窗体。

在form1下面新建3个command按钮，然后打开excel，新建book1,book2，把焦点切换到book1,然后测试以下代码，会把焦点切换到book2：

'form1的代码：

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam 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 Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Const WM_MOUSEACTIVATE = &H21
Private Const WM_LBUTTONDOWN = &H201

Private Sub Command1_Click()
' Call SetNumLock(False) '关闭NumLock键
' CALL MySendKey (vbKeyCapital)
' MsgBox GetAsyncKeyState(vbKeyCapital)
If GetKeyState(vbKeyCapital) = 1 Then '如果CAPSLOCK被按下
SendKeys "{CAPSLOCK}", False
' Call MySendKey(vbKeyCapital)
' ScanCode = MapVirtualKey(vbKeyCapital, 0)
' Call keybd_event(vbKeyCapital, ScanCode, 0, 0)
' Sleep 1000
' Call keybd_event(vbKeyCapital, ScanCode, KEYEVENTF_KEYUP, 0)
' Sleep 1000
End If

Dim dHwnd As Long
Dim tHwnd As Long
dHwnd = FindWindow("XLMAIN", vbNullString)
If dHwnd > 0 Then
tHwnd = FindWindowEx(dHwnd, ByVal 0&, "XLDESK", vbNullString)
If tHwnd > 0 Then
tHwnd = FindWindowEx(tHwnd, ByVal 0&, vbNullString, "Book2")
End If
End If
If tHwnd = 0 Then
MsgBox "请先新建两个空白excel，名字叫做book1,book2"
Exit Sub
End If
SetForegroundWindow dHwnd '激活父窗体
Sleep 1000 '等待窗口切换
'Private Const WM_MOUSEACTIVATE = &H21
' SendMessage tHwnd, WM_MOUSEACTIVATE, 0, 0
' Private Const WM_LBUTTONDOWN = &H201
SendMessage tHwnd, WM_LBUTTONDOWN, 0, 0
' Private Const WM_PARENTNOTIFY = &H210
' Private Const WM_ACTIVATE = &H6
' SendMessage hwnd4, WM_ACTIVATE, 0, 0
' Private Const WM_LBUTTONDOWN = &H201
' SendMessage hwnd4, WM_LBUTTONDOWN, 0, 0
Sleep 1000 '等待窗口切换
' SendKeys "{CAPSLOCK}", FALSE
Sleep 1000
SendKeys "{enter}"
SendKeys "AAA", False
SendKeys "bbb", False
SendKeys "CCC", False
SendKeys "ddd", False
SendKeys "EEE", False

End Sub

Private Sub Command2_Click()
End
End Sub

Private Sub Command3_Click()
dHwnd = FindWindow("Notepad", vbNullString)
If dHwnd > 0 Then
tHwnd = FindWindowEx(dHwnd, ByVal 0&, "Edit", vbNullString)
End If
SetForegroundWindow dHwnd '激活父窗体
MySendKey vbKeyA
End Sub