ユーザーフォームを作り、ボタンを押すとIE又はChromeで任意で指定のURLへ接続するものを作りたく、以下のようなものを作成しました。
現在Chromeのみ接続される状態で、IEボタンを押すと反応しません。
作成手順として、IEボタンを作り、その後Chromeボタンを作成しました。
IEボタン単体の状態では問題なく接続されたのですが、chromeボタンを追加すると反応しなくなりました。
「InternetExplorer.Application」と「WScript.Shell」の両方を動かすことは不可能なのでしょうか?(起動は別々だとは思いますが・・・。)
今後の為、何が起きたか知りたく質問させていただきました。
よろしくお願いします。
以下は問題と思われる部分のコードです
ユーザーフォーム
Dim IELbtn As CommandButton Dim CHLbtn As CommandButton Set IELbtn = .Controls.Add("Forms.CommandButton.1", "IEL", True) Set CHLbtn = .Controls.Add("Forms.CommandButton.1", "CHL", True) Call ctrlURL.SetCtrl(IELbtn, Cells(row, 5)) '’’’’’’’’’’’’’’ Call ctrlURL.SetCtrl(CHLbtn, Cells(row, 5)) With IELbtn .Top = 64 .Left = 10 .Height = 20 .Width = 100 .Caption = "IEでアクセス" End With With CHLbtn .Top = 64 .Left = 120 .Height = 20 .Width = 100 .Caption = "Chromeでアクセス" End With
クラス
If tgtCtrl.Name = "IEL" Then 'Urlボタンの表示 intRow = tgtRange.row URL = Cells(intRow, 5).Copy MsgBox "IEでインターネットへ接続します。" Set ie = CreateObject("InternetExplorer.Application") ie.Navigate Cells(intRow, 5) ie.Visible = True Exit Sub End If If tgtCtrl.Name = "CHL" Then 'Urlボタンの表示 intRow = tgtRange.row URL = Cells(intRow, 5).Copy MsgBox "Chromeでインターネットへ接続します。" Set Ch = CreateObject("WScript.Shell") Ch.Run ("chrome.exe -url " & Cells(intRow, 5)) Set Ch = Nothing Exit Sub End If
以下は全てのコードです
こちらがユーザーフォームです
Private ctrlbtn(1 To 100) As New EventButtonClass Private ctrlURL As New EventButtonClass Sub UserForm_Initialize() Dim Myitem As Object Dim MyPass As Object Dim i As Long Dim Top As Long '項目入力開始位置 Dim row As Long Dim Col As Long Dim item As String row = ActiveCell.row '行番号取得 With UserForm3 Top = 50 '項目開始位置 With .Controls.Add("Forms.Label.1", "タイトル", True) 'タイトル .Top = 10 'Top位置(表示位置を移動する) .Left = 10 'Left位置 .Height = 20 '高さ .Width = 370 '幅 .BorderStyle = fmBorderStyleSingle '枠線 .BackColor = RGB(128, 128, 128) '背景色 .ForeColor = RGB(255, 255, 255) '文字色 .Font.Name = "メイリオ" 'テキストのスタイル .TextAlign = 2 'テキストの位置 .FontSize = 16 'テキストのサイズ .Caption = Cells(row, 3) End With If Cells(row, 5) <> "" Then 'URL有れば Dim IELbtn As CommandButton Dim CHLbtn As CommandButton Set IELbtn = .Controls.Add("Forms.CommandButton.1", "IEL", True) Set CHLbtn = .Controls.Add("Forms.CommandButton.1", "CHL", True) Call ctrlURL.SetCtrl(IELbtn, Cells(row, 5)) '’’’’’’’’’’’’’’ Call ctrlURL.SetCtrl(CHLbtn, Cells(row, 5)) With IELbtn .Top = 64 .Left = 10 .Height = 20 .Width = 100 .Caption = "IEでアクセス" End With With CHLbtn .Top = 64 .Left = 120 .Height = 20 .Width = 100 .Caption = "Chromeでアクセス" End With With .Controls.Add("Forms.Label.1", "url", True) .Top = 34 'Top位置(表示位置を移動する) .Left = 10 'Left位置 .Height = 20 '高さ .Width = 370 '幅 .BorderStyle = fmBorderStyleSingle '枠線 .BackColor = RGB(128, 128, 128) '背景色 .ForeColor = RGB(255, 255, 255) '文字色 .Font.Name = "メイリオ" 'テキストのスタイル .TextAlign = 2 'テキストの位置 .FontSize = 16 'テキストのサイズ .Caption = Cells(row, 5) End With Top = Top + 24 End If item = "初期値" Col = 5 i = 0 Do While item <> "" Col = Col + 1 item = Cells(row, Col) If item = "" Then Exit Do End If i = i + 1 Set Myitem = .Controls.Add("Forms.Label.1", "MyLabel" & i, True) Set MyPass = .Controls.Add("Forms.Label.1", "MyPass" & i, True) With Myitem 'ここは項目表示 .Top = Top + 24 * i 'Top位置(表示位置を移動する) .Left = 70 'Left位置 .Height = 20 '高さ .Width = 150 '幅 .BorderStyle = fmBorderStyleSingle '枠線 .BackColor = RGB(128, 128, 128) '背景色 .ForeColor = RGB(255, 255, 255) '文字色 .Font.Name = "メイリオ" 'テキストのスタイル .TextAlign = 2 'テキストの位置 .FontSize = 16 'テキストのサイズ .Caption = item End With Col = Col + 1 item = Cells(row, Col) With MyPass 'ここは内容表示 .Top = Top + 24 * i .Left = 230 'Left位置 .Height = 20 '高さ .Width = 150 '幅 .BorderStyle = fmBorderStyleSingle '枠線 .BackColor = RGB(128, 128, 128) '背景色 .ForeColor = RGB(255, 255, 255) '文字色 .Font.Name = "メイリオ" 'テキストのスタイル .TextAlign = 2 'テキストの位置 .FontSize = 16 'テキストのサイズ .Caption = item End With Dim Cpybtn As CommandButton Set Cpybtn = .Controls.Add("Forms.CommandButton.1", "copy" & i, True) Call ctrlbtn(i).SetCtrl(Cpybtn, Cells(row, i)) With Cpybtn .Top = Top + 24 * i .Left = 10 .Height = 20 .Width = 50 .Caption = "Copy" .Tag = i End With Loop End With End Sub
こちらがクラスです
Private WithEvents tgtCtrl As MSForms.CommandButton Private tgtRange Public Sub SetCtrl(new_ctrl As MSForms.CommandButton, new_Range As Range) Set tgtCtrl = new_ctrl Set tgtRange = new_Range End Sub Private Sub tgtCtrl_Click() Dim intRow As Long Dim URL As String Dim intcol As Long Dim i As Long Dim ie As InternetExplorer Dim Ch As Variant If tgtCtrl.Name = "IEL" Then 'Urlボタンの表示 intRow = tgtRange.row URL = Cells(intRow, 5).Copy MsgBox "IEでインターネットへ接続します。" Set ie = CreateObject("InternetExplorer.Application") ie.Navigate Cells(intRow, 5) ie.Visible = True Exit Sub End If If tgtCtrl.Name = "CHL" Then 'Urlボタンの表示 intRow = tgtRange.row URL = Cells(intRow, 5).Copy MsgBox "Chromeでインターネットへ接続します。" Set Ch = CreateObject("WScript.Shell") 'ie.Navigate """ & Cells(intRow, 5) & """ Ch.Run ("chrome.exe -url " & Cells(intRow, 5)) Set Ch = Nothing Exit Sub End If MsgBox "コピーしました" i = tgtCtrl.Tag intRow = tgtRange.row intcol = 5 + 2 * i Cells(intRow, intcol).Copy End Sub
よろしくお願いします。
回答2件
あなたの回答
tips
プレビュー
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。