| |
なんか見てないみたいだけど、まあ良いや。
今までできないと思って、やったこと事がなかったのですが、
夜中にやってみたらできたので、中途半端なコードを載せます。
右クリックで起動します。
事前に用意して置いてください。
名簿シートをSheet2とします。
あ行の名簿を A1:A5
か行の名簿を B1:B5
さ行の名簿を C1:C5
た行の名簿を D1:D5
とします。
標準モジュールは前回と同じ。
シートモジュールだけ変更。
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim Cel As Range
'If Target.Column > 1 Then Exit Sub
Cancel = True
With Application.CommandBars.Add(Position:=msoBarPopup, temporary:=True)
With .Controls.Add(Type:=msoControlPopup)
.Caption = "あ行"
For Each Cel In Sheets("Sheet2").Range("A1:A5") '営業担当者の入ったセル範囲、あ行
With .Controls.Add(Type:=msoControlButton)
.Caption = Cel.Value
.FaceId = 80
.OnAction = "マクロ1"
End With
Next
End With
With .Controls.Add(Type:=msoControlPopup)
.Caption = "か行"
For Each Cel In Sheets("Sheet2").Range("B1:B5") '営業担当者の入ったセル範囲、か行
With .Controls.Add(Type:=msoControlButton)
.Caption = Cel.Value
.FaceId = 90
.OnAction = "マクロ1"
End With
Next
End With
With .Controls.Add(Type:=msoControlPopup)
.Caption = "さ行"
For Each Cel In Sheets("Sheet2").Range("C1:C5") '営業担当者の入ったセル範囲、さ行
With .Controls.Add(Type:=msoControlButton)
.Caption = Cel.Value
.FaceId = 98
.OnAction = "マクロ1"
End With
Next
End With
With .Controls.Add(Type:=msoControlPopup)
.Caption = "た行"
For Each Cel In Sheets("Sheet2").Range("D1:D5") '営業担当者の入ったセル範囲、た行
With .Controls.Add(Type:=msoControlButton)
.Caption = Cel.Value
.FaceId = 99
.OnAction = "マクロ1"
End With
Next
End With
.ShowPopup
End With
End Sub
追伸
前回、遅いと思っていたのは遅いＰＣのせいだったみたいです。
Pen4 1.6Gでやってみたら、ストレスなくあっさり表示されました。
|
|
Jaka
- 09/3/6(金) 9:19 -
