即効テクニック |
サンプルではユーザフォーム上のボタンからInternet Explorer(IE)を起動し、以後の移動先URL、タイトル、及びURLへのリンクをあらかじめ準備しておいたワークシートへ書き出します。リンク集を作る際などは、IE終了後、書き出しリンクを見直して、WEBページで保存するか、ハイパーリンク部分をFonrtPageなどのホームページ作成ソフトにコピー&ペーストするとよいでしょう。 (前提)・Intenet Explorer 4.0以上 ・シート名”LINK ”のワークシート(書き出し用) ・ユーザフォーム1つと、フォーム上にコマンドボタン2つ ・"Microsoft Internet Controls"の参照設定 (Visula Basic Editorのメニューから”ツール”−”参照設定” (サンプル - フォームモジュール)
Private WithEvents ObjIE As InternetExplorer 'IEのイベント取得用 '===コマンドボタン1−(IE起動用)=== Private Sub CommandButton1_Click() 'InternetExplorer起動 Set ObjIE = New InternetExplorer ObjIE.Visible = True ObjIE.Navigate "http://MOUG.net" '←適宜変更 End Sub '===コマンドボタン2−(IE終了用)=== Private Sub CommandButton2_Click() '終了 If ObjIE Is Nothing Then Exit Sub ObjIE.Quit Set ObjIE = Nothing End Sub ' ===ページ読み込み完了時のイベント=== Private Sub ObjIE_DocumentComplete(ByVal pDisp As Object, URL As Variant) If ObjIE Is Nothing Then Exit Sub Dim Cnt As Long '行カウンタ With Sheets("LINK") '入力最終行取得(シート最終行から上方向へ) Cnt = .Cells(.Rows.Count, 1).End(xlUp).Row 'LocationURLが前の行と重複していなければ書き込み If ObjIE.LocationURL <> .Cells(Cnt, 2).Value Then .Cells(Cnt + 1, 1).Value = ObjIE.LocationName 'タイトル .Cells(Cnt + 1, 2).Value = ObjIE.LocationURL 'URL .Hyperlinks.Add anchor:=.Cells(Cnt + 1, 3), Address:=ObjIE.LocationURL, _ TextToDisplay:=ObjIE.LocationName 'TextToDisplay引数はXL2000のみ End If End With End Sub '===フォーム初期化イベント=== Private Sub UserForm_Initialize() '”リンク”シートに項目設定 Sheets("LINK").Range("A1:C1").Value = Array("Name", "URL", "Link") 'フォーム上のボタン名変更 Me.CommandButton1.Caption = "IE起動" Me.CommandButton2.Caption = "IE終了" End Sub
※強制的に新しいWindowが開かれるのをキャンセルするには・・・ NewWindow2イベントを使用します。
Private Sub ObjIE_NewWindow2(ppDisp As Object, Cancel As Boolean) Cancel = True End Sub
※リンクの書き込みをタイトル変更時に行いたいときは Private Sub オブジェクト変数名_TitleChange(ByVal Text As String)を用います。 その他さまざまなイベントがありますので、VBEのイベント名ボックスからご確認ください。