|
ダブルクリックしたセルの位置に、複数選択できるフォームのリストボックスを配置し、
その下にボタンを配置します。リストで任意の値を選択した後ボタンを押すと、
選択した文字がメッセージされます。
↓シートモジュールへ
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
Cancel As Boolean)
Dim Lp As Single, Tp As Single
Dim Wp As Single, Hp As Single
Cancel = True
With Target
Lp = .Left: Tp = .Top
Wp = .Width * 2: Hp = .Height
End With
With ActiveSheet.ListBoxes
If .Count > 0 Then .Delete
With .Add(Lp, Tp, Wp, Hp * 3)
.AddItem Array("A", "B", "C", "D", "E", "F")
.MultiSelect = xlSimple
End With
End With
With ActiveSheet.Buttons
If .Count > 0 Then .Delete
With .Add(Lp, Tp + Hp * 3, Wp, Hp)
.Caption = "選択完了"
.OnAction = "Get_MyData"
End With
End With
End Sub
↓標準モジュールへ
Sub Get_MyData()
Dim i As Integer
If VarType(Application.Caller) <> 8 Then Exit Sub
With ActiveSheet.ListBoxes(1)
For i = 1 To .ListCount
If .Selected(i) Then
MsgBox .List(i) & " が選択されています"
End If
Next i
.Delete
End With
ActiveSheet.Buttons.Delete
End Sub
|
|