解説は次に続きます。
'標準モジュール
Public ctrlLabeles As New Collection
Public myClass() As Class1
Public Const N1 As String = "nyuryoku" 'シート名(入力シート)
Public Const N2 As String = "data" 'データシート
Public cnt As Integer 'ページ切り替えのためのカウント
Sub DataChange()
Dim j As Long, i As Long, k As Long
On Error Resume Next
cnt = cnt + 1
If cnt > 2 Then 'ページ数
MsgBox "次のページはありません。"
cnt = 0
Exit Sub
End If
For j = 1 To 3
Worksheets(N1).OLEObjects("問" & j).Object.Caption = Worksheets(N2).Cells((cnt - 1) * 3 + j, 2).Value
For k = 1 To 4
Worksheets(N1).OLEObjects("選択" & j & k).Object.Caption = Worksheets(N2).Cells((cnt - 1) * 3 + j, k + 2).Value
Next k
Next j
Call SetInClassObject
Application.ScreenUpdating = True
Beep
End Sub
Private Sub SetInClassObject()
'クラス生成
Dim ctrl As OLEObject
Dim i As Integer
Dim nyuryoku As Worksheet
Dim data As Worksheet
Set nyuryoku = Worksheets(N1) 'Worksheets("nyuryoku")
Set data = Worksheets(N2) 'Worksheets("data")
For Each ctrl In nyuryoku.OLEObjects
If TypeOf ctrl.Object Is MSForms.Label Then
ctrlLabeles.Add ctrl.Object
ReDim Preserve myClass(i)
Set myClass(i) = New Class1
Set myClass(i).lbl = ctrl.Object
i = i + 1
End If
Next ctrl
End Sub
'Class1
Public WithEvents lbl As MSForms.Label
Private Sub lbl_Click()
Dim buf As String
Dim i As Long, j As Long, n As Long
buf = lbl.Name
If buf Like "選*" Then
i = Replace(Left(buf, Len(buf) - 1), "選択", "")
n = lbl.TopLeftCell.Row
Worksheets(N1).Cells(n, 2).Value = Right(buf, 1)
Worksheets(N2).Cells(i, 7).Value = Right(buf, 1)
Beep
End If
End Sub
お礼
コードまで付けていただいた上、詳しい解説をしていただきありがとうございます。 私のスキルでは、確かにこのコードは少し難しく感じました。( _ _ )..........o クラスモジュール等使ったことのない手法もありましたが、手元の解説書を改めて読むとこれらのことに触れていましたので、それらも参考に何とか出来そうです。\(^ ^)/ ある程度出来上がったら報告しようと思ったのですが、それでは時間がかかってしまいますので、この時点でお礼申し上げます。 有難うございました。