Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


12225 / 13644 ツリー ←次へ | 前へ→

【10850】WebBrowserコントロールで表示したWEB本文のコピー方法 ひら 04/2/16(月) 11:36 質問
【10861】Re:WebBrowserコントロールで表示したWEB本... ichinose 04/2/17(火) 7:52 発言
【10866】Re:WebBrowserコントロールで表示したWEB本... ひら 04/2/17(火) 13:57 質問
【10867】Re:WebBrowserコントロールで表示したWE... コロスケ 04/2/17(火) 15:20 発言
【10884】Re:WebBrowserコントロールで表示したWE... ひら 04/2/17(火) 22:24 お礼
【10952】Re:WebBrowserコントロールで表示したWE... ひら 04/2/19(木) 14:41 質問
【10953】Re:WebBrowserコントロールで表示したWE... コロスケ 04/2/19(木) 15:12 回答
【10964】Re:WebBrowserコントロールで表示したWE... ichinose 04/2/19(木) 17:50 発言
【10990】Re:WebBrowserコントロールで表示したWE... ひら 04/2/22(日) 15:12 発言
【11043】Re:WebBrowserコントロールで表示したWE... ichinose 04/2/24(火) 21:21 発言
【11070】Re:WebBrowserコントロールで表示したWE... ひら 04/2/26(木) 19:07 お礼
【11350】Re:WebBrowserコントロールで表示したWE... ひら 04/3/6(土) 10:33 質問
【11407】Re:WebBrowserコントロールで表示したWE... ichinose 04/3/8(月) 18:06 回答
【11626】Re:WebBrowserコントロールで表示したWE... ひら 04/3/12(金) 14:29 お礼

【10850】WebBrowserコントロールで表示したWEB本...
質問  ひら E-MAIL  - 04/2/16(月) 11:36 -

引用なし
パスワード
   WebBrowserコントロールを使って表示したWebページをコピーしてエクセルのシー
トにテキストとして貼り付ける作業を自動化する方法を教えてください。

【10861】Re:WebBrowserコントロールで表示したWE...
発言  ichinose  - 04/2/17(火) 7:52 -

引用なし
パスワード
   ▼ひら さん:
おはようございます。

>WebBrowserコントロールを使って表示したWebページをコピーしてエクセルのシー
>トにテキストとして貼り付ける作業を自動化する方法を教えてください。
WebBrowserコントロールで以下のコードで実行してもうまく実行されませんでしたが、
EPで実行したらコピーしてくれました。


「参照設定」で「Microsoft Internet Controls」をチェックして下さい。
Thisworkbookのモジュールに
'================================================================
Private WithEvents ep As InternetExplorer
Sub test()
  Set ep = New InternetExplorer
  With ep
    .Visible = True
    .Navigate "http://www.h2.dion.ne.jp/~mtmamiri/ginnryuu.htm"
    End With
End Sub
'================================================================
Private Sub ep_DocumentComplete(ByVal pDisp As Object, URL As Variant)
  With ep
   .ExecWB OLECMDID_SELECTALL, OLECMDEXECOPT_DODEFAULT
   .ExecWB OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT
   End With
  DoEvents
  ActiveSheet.PasteSpecial Format:="テキスト", Link:=False, DisplayAsIcon:=False

End Sub
'================================================================
Private Sub ep_OnQuit()
  Set ep = Nothing
End Sub


これでthisworkbook.testを実行してみて下さい。
同じ命令やイベントがWebBrowserコントロールにもあるのですが、
エラーになってしまいました。
直接の回答ではありませんが、代替できればいいのですが・・・。
(例題のサイトは、私の好きな歌・・・・)

【10866】Re:WebBrowserコントロールで表示したWE...
質問  ひら E-MAIL  - 04/2/17(火) 13:57 -

引用なし
パスワード
   ichinose さんこんにちは

早速ありがとうございました。
Thisworkbookのモジュールにコードをコピーして実行できました。
WEBページのコピーは実現しましたが、ページを渡り歩くたびにコピー動作が
実行されますが。これを目的のページのみコピーすることはできないでしょうか、
私がほしかったのはWebBrowserのようなウィンドウでコピーボタンを押すことに
よりページのコピーできるものですが、可能でしょうか

それと、素敵なサイトの紹介ありがとうございました。曲を再生し楽しんでいま
す。

【10867】Re:WebBrowserコントロールで表示したWE...
発言  コロスケ E-MAILWEB  - 04/2/17(火) 15:20 -

引用なし
パスワード
   こんにちは。WebBrowserコントロールではないのですが、
前にブラウザのテキストを保存するアドインを書いたことがあります(↓こんなやつ)
http://www.interq.or.jp/sun/puremis/colo/soft/TextGetter_readme.txt

パスワードはかけていないので、コードが参考になるかもしれません。
(もしかかっていたら、パスワードはcorosukeで解除できます。)

DLはこちらから...。
http://www.interq.or.jp/sun/puremis/colo/soft/TextGetter.lzh

では。

【10884】Re:WebBrowserコントロールで表示したWE...
お礼  ひら E-MAIL  - 04/2/17(火) 22:24 -

引用なし
パスワード
   コロスケさんこんばんは
情報ありがとうございます。実行してみました
頂いたコードを参考にフォームを作成してみます。
ichinoseさんのコードも参考になります引用させ
てもらいます。しばらくかかると思いますが結果
をレスします。
お二方に先ずは御礼申し上げます。

【10952】Re:WebBrowserコントロールで表示したWE...
質問  ひら E-MAIL  - 04/2/19(木) 14:41 -

引用なし
パスワード
   Ichinoseさん、コロスケさんこんにちは

 紹介いただいたコードを参考に試行してみましたが、うまくいきませんでした。
 私がやりたい操作は、ID,パスワードでログインし条件を入力して開いたホーム
ページをCuT&Pasteモードでエクセルのシートにコピーすることです。シートへの
貼り付けは次のようにしています。
  ActiveSheet.PasteSpecial Format:="HTML", Link:=False, _
    DisplayAsIcon:=False, NoHTMLFormatting:=True
 この方法だとホームページ中に数表があった場合エクセルシートに数表の形で配
置されるためです。
 Ichinoseさんのコードはこの方法で貼り付けでできますが、ホームページが開か
れるたびに(目的のホームページにたどり着くまでに)コピー動作繰り返します。
目的ページだけコピーできたらいいのですが。
 コロスケさんのコードは目的ページだけのデータ取得はできますが、文字列とし
て抽出するため、数表データを取り出すには文字列操作が必要のようです。
 駄々っ子の欲しい物ねだりで申し訳ありませんが他にいい方法がありましたら宜
しくお願いします。

【10953】Re:WebBrowserコントロールで表示したWE...
回答  コロスケ E-MAILWEB  - 04/2/19(木) 15:12 -

引用なし
パスワード
   ひらさん、こんにちは。
ちょっと今バタバタしてるので、簡単なアドバイスだけになってしまいますが、
>Ichinoseさんのコードはこの方法で貼り付けでできますが、
ということなので、彼のコードのイベントの部分(Private Sub ep_DocumentCompleteの部分)を
目的に合わせて呼び出すようにすれば、ご希望の動作になると思います。

【10964】Re:WebBrowserコントロールで表示したWE...
発言  ichinose  - 04/2/19(木) 17:50 -

引用なし
パスワード
   ▼コロスケ さん、ひらさん、こんにちは。

コロスケさんのコードでOKだと思っていましたし、素晴らしかったので(私も使わせて頂きます)、おまかせだったんですが・・・。
こんなふうにしてみたらどうでしょうか。
まず、EPを起動したり、閉じたときの処理をするコード。
'===============================================================
Private WithEvents ep As InternetExplorer
Private docu_comp As Boolean
'===============================================================
Sub main()
  Set ep = New InternetExplorer
  With ep
    .Visible = True
    .Navigate "http://www.h2.dion.ne.jp/~mtmamiri/ginnryuu.htm"
    End With
End Sub
'===============================================================
Private Sub ep_BeforeNavigate2(ByVal pDisp As Object, URL As Variant, Flags As Variant, TargetFrameName As Variant, PostData As Variant, Headers As Variant, Cancel As Boolean)
  docu_comp = False
End Sub
'===============================================================
Private Sub ep_DocumentComplete(ByVal pDisp As Object, URL As Variant)
  docu_comp = True
End Sub
'===============================================================
Private Sub ep_OnQuit()
  Set ep = Nothing
  docu_comp = False
End Sub

そして、対象サイトをコピー&貼付するコード
'===============================================================
Sub docu_copy_paste()
  If docu_comp = True Then
   With ep
    .ExecWB OLECMDID_SELECTALL, OLECMDEXECOPT_DODEFAULT
    .ExecWB OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT
    End With
   DoEvents
   ActiveCell.Select
   ActiveSheet.PasteSpecial Format:="HTML", Link:=False, _
    DisplayAsIcon:=False ', NoHTMLFormatting:=True
'                 Excel2000にはないオプションですよね
'                 確認してコメント外して下さい
   End If
End Sub

というようにして見ました。

実は、Webbrowserコントロールでも「全てを選択」---「コピー」
(上記のコードの

   With ep
    .ExecWB OLECMDID_SELECTALL, OLECMDEXECOPT_DODEFAULT
    .ExecWB OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT
    End With

の箇所)

Sendkeysメソッドを使用すると、可能な事がわかりまして、ちょっと作ってみましたが、
コピー&ペーストは出来ますが、何故かやっぱり動きが不安定でした(Excel終了後、異常終了してみたり・・・)。

これで確認してみて下さい。

【10990】Re:WebBrowserコントロールで表示したWE...
発言  ひら E-MAIL  - 04/2/22(日) 15:12 -

引用なし
パスワード
   ichinose さん、コロスケ さん こんにちは。

返信が遅くなりました。情報ありがとうございます。
これで目的のページのコピーができました。使わせていただきます。
なお、WebBrowserコントロールにこだわっており、次のような
コードで実験していますが
 'ExecWB'メソッドは失敗しました'IwebBrowser2'オブジェクト>
というエラーがでます。WEBを検索したらIwebBrowser2を取得したら
使えるとあるだけで具体的な方法がわかりません。
Private Sub WebWindow_DocumentComplete(ByVal pDisp As Object, _
     URL As Variant)
 if URL = "http://......" '目的ページのURL
 Then
  With WebWindow
    .ExecWB OLECMDID_SELECTALL, OLECMDEXECOPT_DODEFAULT
    .ExecWB OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT
    .....以下貼り付け.....
  End With
 End If

WebBrowserコントロールで実現できたら、メニューやコマンドボタンを
なくすることができ不要な操作を防げたり、またVBAとIEの同期が取れな
いので、VBAからIE起動を発行するとVBAは次のステップ以降を実行して
しまいますが、これも解決できるのでは思っています。........

【11043】Re:WebBrowserコントロールで表示したWE...
発言  ichinose  - 04/2/24(火) 21:21 -

引用なし
パスワード
   ▼ひら さん:
こんばんは。
>なお、WebBrowserコントロールにこだわっており、次のような
>コードで実験していますが
> 'ExecWB'メソッドは失敗しました'IwebBrowser2'オブジェクト>
>というエラーがでます。WEBを検索したらIwebBrowser2を取得したら
>使えるとあるだけで具体的な方法がわかりません。

      ↓のWebWindowって、WebBrowserコントロールのことですよね?

>  With WebWindow
    .SetFocus
    Application.SendKeys "^a", True
    Application.SendKeys "^c", True
    DoEvents
    ActiveCell.Select
>>    .....以下貼り付け.....
>  End With
> End If
>

のように、Sendkeysメソッドを使用するとコピーは出来ますよ!!
(個人的には、好みの方法ではありませんが・・・)。

【11070】Re:WebBrowserコントロールで表示したWE...
お礼  ひら E-MAIL  - 04/2/26(木) 19:07 -

引用なし
パスワード
   ▼ichinose さん コロスケ さんこんばんは

>      ↓のWebWindowって、WebBrowserコントロールのことですよね?
>
>>  With WebWindow
>    .SetFocus
>    Application.SendKeys "^a", True
>    Application.SendKeys "^c", True
>    DoEvents
>    ActiveCell.Select
>>>    .....以下貼り付け.....
>>  End With
>> End If

これでばっちり解決しました。ご指摘のとおりWebWindowっはWebBrowserコント
ロールの名前です。

それからコロスケさんにいただいたテキスト取り出しも大いに参考になり、閲覧し
たWEBページに目的の文字列があるか検索するのに役立っています。

お二人には大変お世話になりました。今後ともよろしくお願いします。

【11350】Re:WebBrowserコントロールで表示したWE...
質問  ひら  - 04/3/6(土) 10:33 -

引用なし
パスワード
   ▼ichinose さんこんにちは

>  With WebWindow
>    .SetFocus
>    Application.SendKeys "^a", True
>    Application.SendKeys "^c", True
>    DoEvents
>    ActiveCell.Select
>    .....以下貼り付け.....
>  End With
> End If

 上のコードでコピーはできるようになりましたが、動作が不安定で4〜5回程度
に1回の割合でしか実行できません。(クリップボードには何も入っていないか、
以前にクリップした内容が残ったままとなっています。)
フォーカスがWebWindowにかからないのか、SendKeysの実行を待たずに次のステッ
プに進んでしまうのかわからない状況です。Winth〜With Endの外側をDo loop
で括って何回かループしたり、.SetFocusを2個以上つけたりしましたが、少しは
効果らしいものはありましたが、決め手になるような結果になりませんでした。
 それとついでで申し訳ありませんがクリップボードにクリップされたかどうかの
確認や、クリップボードをクリアする方法をご存知でしたらよろしくお願いします。(これは当質問箱(番号11315)で質問しています)

【11407】Re:WebBrowserコントロールで表示したWE...
回答  ichinose  - 04/3/8(月) 18:06 -

引用なし
パスワード
   ▼ひら さん:
こんにちは。

>
>>  With WebWindow
>>    .SetFocus
>>    Application.SendKeys "^a", True
>>    Application.SendKeys "^c", True
>>    DoEvents
>>    ActiveCell.Select
>>    .....以下貼り付け.....
>>  End With
>> End If
>
> 上のコードでコピーはできるようになりましたが、動作が不安定で4〜5回程度
>に1回の割合でしか実行できません。(クリップボードには何も入っていないか、
>以前にクリップした内容が残ったままとなっています。)
>フォーカスがWebWindowにかからないのか、SendKeysの実行を待たずに次のステッ
>プに進んでしまうのかわからない状況です。Winth〜With Endの外側をDo loop
>で括って何回かループしたり、.SetFocusを2個以上つけたりしましたが、少しは
>効果らしいものはありましたが、決め手になるような結果になりませんでした。
> それとついでで申し訳ありませんがクリップボードにクリップされたかどうかの
>確認や、クリップボードをクリアする方法をご存知でしたらよろしくお願いします。(これは当質問箱(番号11315)で質問しています)
これは、ひらさんのご質問を考えているときに経験しました。
例えば、

http://www.microsoft.com/japan/msdn/library/default.asp

のようにフレームのあるサイトではIEを使用しても同じなんですが、
サイトが表示された直後、「すべて選択」ができません。
これは、webbrowserのSetfocusでも駄目でした。
この場合、私が試行したかぎりでは、一度WebBrowserをクリックしないとコピーできませんでした。
よって、このようなサイトを表示したときにコピー&ペーストのコードを実行しても
以前のクリップボードの内容がペーストされてしまう現象が起こります。

私は、こんなコードにしてみましたが、いかがでしようか?

例えば、

ユーザーフォーム(Userform1)には、
テキストボックス(Textbox1)ひとつ(URL入力用)
ウェブブラウザー(WebBrowser1)ひとつ
コマンドボタンふたつ
(Commandbutton1---Textbox1に入力されたURLのNavigate用)
(Commandbutoon2----コピー&ペースト用)
の4つのコントロールを配置します。
標準モジュールで
'========================================================
Sub main()
  UserForm1.Show vbModeless
End Sub

Userform1のモジュールで
'========================================================
Private dsp_flg As Boolean
'========================================================
Private Sub CommandButton1_Click()
  On Error Resume Next
  With WebBrowser1
   If TextBox1.Text <> "" Then
     dsp_flg = False
     .Navigate TextBox1.Text
     Do While dsp_flg = False
      DoEvents
      Loop
     If Err.Number <> 0 Then
      MsgBox Error$(Err.Number)
      End If
     End If
   End With
End Sub
'========================================================
Private Sub CommandButton2_Click()
  On Error Resume Next
  If dsp_flg = True Then
   Call del_clip
   With WebBrowser1
    .SetFocus
    Application.SendKeys "^a", True
    Application.SendKeys "^c", True
    DoEvents
    ActiveCell.Select
    ActiveSheet.PasteSpecial Format:="HTML", Link:=False, _
    DisplayAsIcon:=False
    If Err.Number <> 0 Then
      MsgBox Error$(Err.Number)
      End If
    End With
   End If
End Sub
'========================================================
Private Sub WebBrowser1_BeforeNavigate2(ByVal pDisp As Object, URL As Variant, Flags As Variant, TargetFrameName As Variant, PostData As Variant, Headers As Variant, Cancel As Boolean)
  dsp_flg = False
End Sub
'========================================================
Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
  dsp_flg = True
End Sub
'========================================================
Sub del_clip()
  On Error Resume Next
  Application.CommandBars("Clipboard").Controls(4).Execute
  On Error GoTo 0
End Sub


フォームが表示されたらテキストボックスにURLを指定してCommandbutton1をクリックして下さい。
その後に、Commandbutton2でコピー&ペーストです。
この時、上述のフレームのあるサイト等では、エラーメッセージを表示します。
(私は、エラーコードそのままメッセージにしましたが、コードを調べて
適当なエラーメッセージに変えてください)

【11626】Re:WebBrowserコントロールで表示したWE...
お礼  ひら  - 04/3/12(金) 14:29 -

引用なし
パスワード
   ▼ichinose さんこんにちは。

返信が遅くなりました。
紹介いただいたコードを使わせて貰いました。
数十回実行してみましたが、クリップミスも無くコピー・貼り付けの動作が実行で
きました。また、特に次のコードは考えにも及びませんでした。

>     dsp_flg = False
>     .Navigate TextBox1.Text
>     Do While dsp_flg = False
>      DoEvents
>     Loop

これまで、幼稚な質問に対し快く受けて頂き、多数行にわたるコーディング例をま
じえての回答に感謝しています。ありがとうございました。
これからよろしくお願いします。

12225 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free