- PDF 無料ダウンロード

Size: px

Start display at page:

Download ""

えりかえいさか
5 years ago
Views:

1 ホームページ (URL) を開く閉じる益永八尋 VBA からホームページを開いたり閉じたりしますホームページを開くはシート名 HP_Open で操作しホームページを閉じるはシート名 "HP_Close" で操作しますホームページを開く方法はいくつかありますがここでは 1 例のみを表示しますなおこれは Web から入手したサンプルプログラムから使い勝手が良いように修正追加したものです使用頻度の高い HP は下表に URL を登録し表示するものだけを表示させるようにできます表は最大 20 件まで登録できますがプログラム (VBA) の変更を行えば登録件数を増やせますプログラムコードは公開していますのでこの EXCEL をダウンロードすることで修正が可能ですなお実行のボタンをクリックしないでも URL をクリックすればクリックした URL のみが表示されます

4 URL を開く Ⅰ. モジュール構成 Ⅱ.Microsoft Excel Objects Sheet1(HP_Open) に記述されているコード注 ) 下記コードはコマンドボタン 1 がクリックされたときに実行されるコードですコマンドボタンは Sheet1(HP_Open) に貼り付けられている Private Sub CommandButton1_Click() ActiveWorkbook.Sheets("HP_Open").Select J = 0 ' For I = 1 To 20 MyURL(I) = Cells(I + 20, 3) MyKey(I) = Cells(20 + I, 6)

5 ' If Cells(I + 20, 3) = "" Then Dn = I - 1 Exit For ' A1 = Left(MyURL(I), 7) A2 = Left(MyURL(I), 8) ' If A1 <> " And A2 <> " Then MsgBox I & " 番目 " & MyURL(I) & " は URL の書式になっていない " & Chr(13) & " 変更してください " End ' Next I ' For I = 1 To Dn ' If MyKey(I) = " 有 " Then Call Module1.URL_Open1 ' Next I

6 ' End End Sub Ⅲ. 標準モジュール Module1 に記述されているコード Public MyURL(20) As String Public MyKey(20) As String Public I As Integer Public Dn As Integer Public J As Integer Sub URL_Open1() On Error GoTo errhandler ' AA = Shell("EXPLORER.EXE" & Space(1) & MyURL(I), vbminimizedfocus) ' 'URL を確実に開くには下記 2 行のコードが必要と思われるこのコードがない場合には 'URL を表示する時間が短くなり表示される前に次の URL を開くコードが実行されるこ ' とになるこのため表示されるべき URL が表示されないままになる J = J + 1 MsgBox J & " 番目 " & MyURL(J) ' If AA = Null Then

7 MsgBox " 指定された URL は開けません " & Chr(13) & "URL が正確でないまたは HP が削除されています " ' Exit Sub errhandler: errno = Err.Number MsgBox Err.Description Resume Next End Sub errno = Err.Number MsgBox Err.Description Resume Next End Sub

8 URL を開く Ⅰ. モジュール構成 Ⅱ.Microsoft Excel Objects Sheet2(HP_Close) に記述されているコード注 ) 下記コードはコマンドボタン 1 と 2 がクリックされたときに実行されるコードですコマンドボタンは Sheet2(HP_Close) に貼り付けられている Private Sub CommandButton1_Click() ' 現在開いている HP のリストを作成する Call Module2.URL_List End End Sub Private Sub CommandButton2_Click()

9 ' 現在開いている HP のリストから指定した HP を閉じる Call Module2.URL_Close End End Sub Ⅲ. 標準モジュール Module2 に記述されているコード Sub URL_List() ' 現在開いている URL の List を作成しシート名 HP_Close" に出力する Dim objshell As Object Dim objie As Object Dim J As Integer ' On Error GoTo errhandler ' これでエクスプローラーのウインドウを取得する Set objshell = CreateObject("Shell.Application") ' 後ろから消してく.Windows でエクスプローラーとインターネットエクスプローラーに触れる ' Dn = objshell.windows.count ' 現在開いている URL の個数を得る ' For I = Dn To 1 Step -1 '

10 数 Set objie = objshell.windows(i - 1) 'I 番目のウインドウを代入 ' '.FullName で普通のファイルエクスプローラーと IE( インターネットエクスプローラー ) を区別する MyPath = objie.fullname 'IE( インターネットエクスプローラー ) の Path 名 'AA = Right(UCase(objIE.FullName), 12) 'Ucase: アルファベットの小文字を大文字に変換する関 AA = Right(MyPath, 12) If AA = "IEXPLORE.EXE" Or AA = "iexplore.exe" Then MyURL(Dn - I + 1) = objie.document.url ' 現在開いている URL を取得する ' Set objie = Nothing Next I ' Set objshell = Nothing ' ' 現在開いている URL の List を作成 Sheets("HP_Close").Select J = 0 ' For I = 1 To Dn If MyURL(I) <> "" Then J = J + 1

11 Cells(I + 20, 3) = MyURL(J) Next I ' Exit Sub ' errhandler: errno = Err.Number DOK = MsgBox(Err.Description & Chr(13) & " 終了します ", vbyesno) If DOK = vbyes Then End Else Resume Next End Sub Sub URL_Close() ' 現在開いている URL の List から閉じる URL( ホームページ ) を指定した URL を終了させる Dim objshell As Object Dim objie As Object Dim n As Integer ' ' 現在開いている URL の List を作成

12 数 Sheets("HP_Close").Select For I = 1 To 20 MyKey(I) = Cells(I + 20, 6) ' If Cells(I + 20, 3) = "" Then Dm = I - 1 Exit For Next I ' ' これでエクスプローラーのウインドウを取得する Set objshell = CreateObject("Shell.Application") ' Dn = objshell.windows.count ' 現在開いている URL の個数を得る For I = Dn To 1 Step -1 ' Set objie = objshell.windows(i - 1) 'I 番目のウインドウを代入 ' '.FullName で普通のファイルエクスプローラーと IE( インターネットエクスプローラー ) を区別する MyPath = objie.fullname 'IE( インターネットエクスプローラー ) の Path 名 'AA = Right(UCase(objIE.FullName), 12) 'Ucase: アルファベットの小文字を大文字に変換する関 AA = Right(MyPath, 12) BB = objie

13 ' If AA = "IEXPLORE.EXE" Or AA = "iexplore.exe" Then ' 現在開いている URL を取得する MyURL(Dn - I + 1) = objie.document.url する ' If MyURL(Dn - I + 1) <> "" Then If MyKey(Dn - I + 1) = " 有 " Then objie.quit 'Call Module2.ie_close ' Sheets("HP_Close").Select ' 閉じた URL をリストから削除する Cells(20 + Dn - I + 1, 3) = "" Cells(20 + Dn - I + 1, 6) = "" ' Next I ' Set objshell = Nothing ' 最後に開いた URL から若い順番に URL を取得 ' '.QUIT で該当 URL を閉じる

14 End Sub 2012/10/24

1. 入力画面

1. 入力画面指定した時刻に指定したマクロ (VBA) を実行するプログラム (VBA) 益永八尋様々な業務を行っている場合には指定した時刻に指定したマクロ (Macro VBA) を実行したくなる場合があるたとえば 9:00 17: 00 や 1 時間 6 時間間隔に指定したマクロ (Macro VBA) を実行するこの様な場合に対応できるように汎用性の高いプログラムを作成したこの場合に注意する必要があるのは