Skip to content

Instantly share code, notes, and snippets.

@kumatti1
Created November 6, 2012 23:34
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save kumatti1/4028479 to your computer and use it in GitHub Desktop.
Save kumatti1/4028479 to your computer and use it in GitHub Desktop.
CommandStateChange イベントでよろしく。

VBAでJAVAをコントロール http://okwave.jp/qa/q7696164.html

・(FindWindowの第二引数で指定する)MsgBoxのウィンドウタイトルは、OSやIEによって違うので適宜修正。 ・Office2010以前は、LongPtrはLongに変更。 (PtrSafe属性も外してください) ・URLも適宜変更。

・MsgBoxが非アクティブ時にイベントが発生してるのでGetLastActivePopupは使えません。

'YU-TAMG氏のコード改
'https://gist.github.com/1619670
' 要・Microsoft Internet Controls 参照設定
Option Explicit
Private Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As Long
Private Declare PtrSafe Function GetLastActivePopup Lib "user32" (ByVal hwndOwnder As LongPtr) As LongPtr
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Const WM_COMMAND As Long = &H111&
Private WithEvents ie As InternetExplorer
Private mDocumentComplete As Boolean
Private m_CommandStateChange As Boolean
Private Sub Class_Initialize()
Set ie = New InternetExplorer
ie.Visible = True
Navigate "about:blank"
End Sub
Public Sub Navigate(ByRef URL As String)
mDocumentComplete = False
ie.Navigate2 URL
Do
DoEvents
Loop Until mDocumentComplete
End Sub
Public Property Get IeObject() As InternetExplorer
Set IeObject = ie
End Property
Private Sub ie_CommandStateChange(ByVal Command As Long, ByVal Enable As Boolean)
Dim hwnd As LongPtr
hwnd = FindWindow("#32770", "Web ページからのメッセージ")
' hwnd = GetLastActivePopup(ie.hwnd)
If hwnd <> 0 Then
Debug.Print hwnd, ie.hwnd
PostMessage hwnd, WM_COMMAND, vbOK, 0
m_CommandStateChange = True
End If
End Sub
Private Sub ie_DocumentComplete(ByVal pDisp As Object, URL As Variant)
mDocumentComplete = True
End Sub
Public Sub CommandStateChange()
m_CommandStateChange = False
Do
DoEvents
Loop Until m_CommandStateChange
End Sub
Option Explicit
Public Sub TestIE_Automation()
Const URL As String = "http://www.tagindex.com/javascript/window/confirm.html"
Dim ie As CIE
Debug.Print "Start", Now
Set ie = New CIE
ie.Navigate URL
'ボタンクリックコード追加
ie.CommandStateChange
Debug.Print "Exit", Now
End Sub
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment