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