Excel UserFormで起動済みのIEから表を取得する、
そんなテストを行っていますが、
操作性が悪いので、
テストしながら泥縄式に改善していきます
テストで使用したExcelブックを
test/Book20170809.zip
に保存しました。アレンジして使ってみてください。
1.なぜ知らなかったんだ?※三流だから?
Excel UserForm Mode モードレス
について
https://www.youtube.com/watch?v=xoQ6G87wRic
www.youtube.com
Excel UserForm モード
で検索すると、
UserForm1.Show vbModeless
なんて、コードがチラホラ見つかります。
vbModeless モードレス?百聞は一見に・・・やってみよう。
'モードの違いを実験してみてください
テストフォーム.Show vbModeless
と
テストフォーム.Show
の違いを確認してみてください。
2.IEの切り替え 前面にもってくるには?
テストでも、
後ろに行ったIEをタスクバー
や
alt+Tab
などで、前にもってきて、テストしていました。
【VBA IE操作】IEの切り替え 前面にもってくるには?SetForegroundWindow【三流君】 - YouTube
www.youtube.com
せっかく、選んで、グローバル変数IEに保存しているのだから、
自然な流れで、前面にくるといいなぁ・・・
VBA API 前面
で 検索 すると、下記のサイトなどが見つかります。
https://www.moug.net/tech/acvba/0020028.html
指定したウィンドウをフォアグラウンドウィンドウにする
(Access 2000/2002/2003)
より
Declare Sub SetForegroundWindow Lib "user32" (ByVal hwnd As Long)
を使用すると、可能なので、テストしてみます。
'標準モジュールにAPI宣言を書く
Declare Sub SetForegroundWindow Lib "user32" (ByVal hwnd As Long)
あとは、単純に
'前面に持ってくる
SetForegroundWindow (IE.hwnd)
みたいに
IEが持っているプロパティの.hwndを渡しただけです。
3.ページの切替後に 手動でTABLE取得のボタンを押すのは変だよね?
ページを読み終わったら、自動で 新しいページのテーブル処理したいよね
そんな時、便利なのが、
WithEvents
※今2017年です、WithBの話でも...と思いつつやめときます。
おっさんは with スーパーモンキーズ かな???
IE操作 VBA WithEvents で IEのイベントを拾う _DocumentComplete イベントに処理を書く #VBA #WithEvents おっさん世代はWithスーパーモンキーズ - YouTube
www.youtube.com
イベント処理を書きたいので
Dim WithEvents IE
で変数定義して、イベント処理を使います。
すると、
'読み込み完了のイベント Private Sub IE_DocumentComplete(ByVal pDisp As Object, URL As Variant) Debug.Print "読み込み完了" & URL Call btnテーブル探す_Click End Sub
みたいに、
_DocumentComplete の 読み込み完了後のイベントが使えます。
4.作成したソース全体
'標準モジュールにAPI宣言を書く Declare Sub SetForegroundWindow Lib "user32" (ByVal hwnd As Long) ' https://www.moug.net/tech/acvba/0020028.html を 参考に ' 指定したウィンドウをフォアグラウンドウィンドウにする Sub ボタン1_Click() 'モードの違いを実験してみてください テストフォーム.Show vbModeless End Sub Sub ボタン2_Click() テストフォーム.Show End Sub ||<< フォームのモジュールに >|vb| 'WithEvents で イベントを拾えるようにする Dim WithEvents IE As InternetExplorer Dim IE_BOX(10) As Object Private Sub btnBODY_InnerTEXT_Click() Dim objBODY As HTMLBody If IE Is Nothing Then Exit Sub 'IEの中身が無ければ関数を抜ける Set objBODY = IE.document.body 'Document.Bodyを変数に代入 Me.txtINFO.Text = objBODY.innerText '.Innertxtの値をテキストボックスへ End Sub Private Sub btnBODY_OuterHTML_Click() Dim objBODY As HTMLBody If IE Is Nothing Then Exit Sub 'IEの中身が無ければ関数を抜ける Set objBODY = IE.document.body 'Document.Bodyを変数に代入 Me.txtINFO = objBODY.outerHTML '.outerHTMLの値をテキストボックスへ End Sub Private Sub btnExcel出力_Click() '未選択のチェック If Me.cbTABLELIST.ListIndex = -1 Then Me.Caption = "未選択 TABLEを選択してください" 'Formタイトルバーに未選択を表示 Exit Sub '関数を途中で抜ける End If '選択されていたら、作業シートに書き込む Dim 最終行 As Integer '急に漢字の変数使うなよ・・・ Sheets("作業").Select 'データセット先に切り替える 最終行 = Cells(Rows.Count, 1).End(xlUp).Row + 1 '最終行+1からセットする Cells(最終行, 1).Select 'カーソルを移動させる DoEvents 'テーブルを探す 'タグの取出しが、.getElementsByTagName("TABLE")で 可能なので、 Dim objTABLEs As Object 'TABLEを複数 格納用 'TABLEタグを複数取り出す Set objTABLEs = IE.document.getElementsByTagName("table") '表をDATAシートに書き出す Dim x As Integer '列の管理 Dim y As Integer '行の管理 Dim n As Integer 'TABLEの管理 'Webの表をシートへ転記(代入する) n = Me.cbTABLELIST.ListIndex 'コンボボックスの選択位置を代入 For y = 0 To objTABLEs(n).Rows.Length - 1 '行の数 ループ For x = 0 To objTABLEs(n).Rows(y).Cells.Length - 1 '列のループ 'objTABLEs(テーブル).Rows(行).Cells(列).テキスト値 Cells(最終行 + y, 1 + x) = objTABLEs(n).Rows(y).Cells(x).innerText Next x Next y '書き込み終了メッセージ MsgBox "シートに書き込みました、確認してください" End Sub Private Sub btnテーブル探す_Click() 'タグの取出しが、.getElementsByTagName("TABLE")で 可能なので、 Dim objTABLEs As Object 'TABLEを複数 格納用 Dim n As Integer Dim strWORK As String Me.cbTABLELIST.Clear 'TABLE選択用のコンボボックスをクリア、初期化 'TABLEタグを複数取り出す Set objTABLEs = IE.document.getElementsByTagName("table") If objTABLEs.Length = 0 Then 'テーブルが見つからなかったら Me.txtINFO.Text = "TABLEが見つかりません" Exit Sub '関数を抜ける End If 'テーブルが見つかったら、 Me.txtINFO.Text = "TABLEが" & objTABLEs.Length & "個 見つかりました" & vbCrLf For n = 0 To objTABLEs.Length - 1 'TABLEの数ループ '左上の見出しをコンボボックスへ strWORK = "TABLE(" & n & "):" & objTABLEs(n).Rows(0).Cells(0).innerText Me.cbTABLELIST.AddItem Left(strWORK, 80) 'コンボボックスへ追加 Me.txtINFO.Text = Me.txtINFO.Text & strWORK & vbCrLf '情報エリアにも書く Next n End Sub 'コンボボックスでIEが選択されたら Private Sub cbIELIST_Change() Debug.Print Me.cbIELIST.ListIndex & "番目を選択" '未選択のチェック If Me.cbIELIST.ListIndex = -1 Then Me.Caption = "未選択 IEを選択してください" 'Formタイトルバーに未選択を表示 Exit Sub '関数を途中で抜ける End If '選択されたら、 Set IE = IE_BOX(Me.cbIELIST.ListIndex) '選択されたn番目のIEを代入する '前面に持ってくる SetForegroundWindow (IE.hwnd) Call btnテーブル探す_Click Me.Caption = Me.cbIELIST.Text '選択されたコンボボックス値をFormタイトルへ Me.txtINFO.Text = Me.cbIELIST.Text & " を 選択しました" End Sub Private Sub btnIE探す_Click() 'オブジェクトを格納する変数 Dim objShell As Object, objWindow As Object Dim n As Integer Me.cbIELIST.Clear '選択用のコンボボックスをクリア、初期化 'シェルのオブジェクトを作成する Set objShell = CreateObject("Shell.Application") 'ウインドウの数だけまわすぞ n = 0 For Each objWindow In objShell.Windows 'TypeNameでオブジェクト変数のタイプを表示する Debug.Print "タイプは:" & TypeName(objWindow.document) 'HTMLDocumentだったら If TypeName(objWindow.document) = "HTMLDocument" Then 'URLとタイトルをコンボボックスへ追加 Me.cbIELIST.AddItem Left("IE(" & n & "):Title=" & objWindow.document.Title & "):URL=" & objWindow.document.URL, 80) Debug.Print "タイトル:" & objWindow.document.Title Debug.Print "URL:" & objWindow.document.URL 'IEを保存 代入する Set IE_BOX(n) = objWindow '配列に保存しておく 'nカウンタを増やす n = n + 1 If n = 9 Then Exit For 'MAX9個までとする End If Next Set objShell = Nothing End Sub Private Sub btn閉じる_Click() Unload Me '自分自身を閉じる End Sub 'テーブルのコンボボックスが選択されたら、 Private Sub cbTABLELIST_Change() Debug.Print Me.cbTABLELIST.ListIndex & "番目を選択" '未選択のチェック If Me.cbTABLELIST.ListIndex = -1 Then Me.Caption = "未選択 TABLEを選択してください" 'Formタイトルバーに未選択を表示 Exit Sub '関数を途中で抜ける End If '選択されたら、情報エリアに書き込む 'テーブルを探す 'タグの取出しが、.getElementsByTagName("TABLE")で 可能なので、 Dim objTABLEs As Object 'TABLEを複数 格納用 'TABLEタグを複数取り出す Set objTABLEs = IE.document.getElementsByTagName("table") 'まず、選択位置を出力 Me.txtINFO.Text = Me.cbTABLELIST.ListIndex & "番目を選択" & vbCrLf '表をテキストボックスに書き出す Dim x As Integer '列の管理 Dim y As Integer '行の管理 Dim n As Integer 'TABLEの管理 Dim strWORK As String '一時保管用 'Webの表をテキストボックスへ転記(代入する) n = Me.cbTABLELIST.ListIndex 'コンボボックスの選択位置を代入 For y = 0 To objTABLEs(n).Rows.Length - 1 '行の数 ループ For x = 0 To objTABLEs(n).Rows(y).Cells.Length - 1 '列のループ 'objTABLEs(テーブル).Rows(行).Cells(列).テキスト値 strWORK = objTABLEs(n).Rows(y).Cells(x).innerText Me.txtINFO.Text = Me.txtINFO.Text & strWORK & "," 'テキストボックスにつなげる Next x Me.txtINFO.Text = Me.txtINFO.Text & vbCrLf 'テキストボックスを改行 Next y End Sub Private Sub CommandButton1_Click() SetForegroundWindow (IE.hwnd) End Sub '読み込み完了のイベント Private Sub IE_DocumentComplete(ByVal pDisp As Object, URL As Variant) Debug.Print "読み込み完了" & URL Call btnテーブル探す_Click End Sub Private Sub UserForm_Initialize() Call btnIE探す_Click End Sub
テストで使用したExcelブックを
http://ie.vba-ken3.jp/test/Book20170809.zip
に保存しました。アレンジして使ってみてください。