ユーザーフォーム3のボタンに(henbtn)、コマンドボタン(コントロールとRangeをクラスに格納しました。)
このボタンhenbtnを押すとユーザーフォーム2が起動します。
henbtnのCtrlがセットされているクラスには、tgtCtrlとtgtRangeが使える状態になっているのですが、ユーザーフォーム2では使えません。
ユーザーフォーム2へデータ(tgtCtrlとtgtRange)を引き渡すにはどんな設定が必要でしょうか。
ユーザーフォーム2で呼び出すと「Typeブロック外では無効なステートメントです」というエラーが発生します。
ユーザーフォーム3
Private ctrlbtn(1 To 100) As New EventButtonClass Private ctrlURL As New EventButtonClass Private ctrlCRL As New EventButtonClass Private ctrlhen 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 Dim henbtn As CommandButton Set IELbtn = .Controls.Add("Forms.CommandButton.1", "IEL", True) Set CHLbtn = .Controls.Add("Forms.CommandButton.1", "CHL", True) Set henbtn = .Controls.Add("Forms.CommandButton.1", "HEN", True) Call ctrlURL.SetCtrl(IELbtn, Cells(row, 5)) '’’’’’’’’’’’’’’ Call ctrlCRL.SetCtrl(CHLbtn, Cells(row, 5)) Call ctrlhen.SetCtrl(henbtn, 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 henbtn .Top = 64 .Left = 230 .Height = 20 .Width = 100 .Caption = "変更" 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 'Top位置(表示位置を移動する) .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
クラス
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") Ch.Run ("chrome.exe -url " & Cells(intRow, 5)) Set Ch = Nothing Exit Sub End If If tgtCtrl.Name = "HEN" Then UserForm2.Show vbModeless Unload UserForm3 Exit Sub End If MsgBox "コピーしました" i = tgtCtrl.Tag intRow = tgtRange.row intcol = 5 + 2 * i Cells(intRow, intcol).Copy End Sub
回答1件
あなたの回答
tips
プレビュー