clsButton

Option Explicit

Private WithEvents Btn As MSForms.CommandButton 'イベントを設定する対象のオブジェクト・・・ユーザーフォームのコマンドボタン
Private PriCellArea    As Range:                '入力対象セル
Private PriForm        As MSForms.UserForm      'ボタンが設置されるユーザーフォーム
Private PriClickEscape As Boolean               'ボタンをクリックで非表示にするかどうか

Public Property Set TargetBtn(ByVal Btn_ As MSForms.CommandButton)
'イベントを設定するボタンを設定
    Set Btn = Btn_
End Property

Public Property Set Form(Form_ As MSForms.UserForm)
'Form設定
    Set PriForm = Form_
End Property

Public Property Let ClickEscape(ClickEscape_ As Boolean)
'ClickEscape設定
    PriClickEscape = ClickEscape_
End Property

Private Sub Btn_Click()
    
'    PbSelectValue = Btn.Caption 'ユーザーフォームのプロパティに選択した値を格納
    If PriCellArea Is Nothing Then GoTo EndEscape '入力対象のセルが設定されていない場合はセル出力の動作は行わない
    
    Call S__選択セルに値入力
    
EndEscape:
    If PriClickEscape = True Then
        Unload PriForm
    End If
    
End Sub

Public Property Set CellArea(CellArea_ As Range)
'CellArea設定
    Set PriCellArea = CellArea_
End Property

Private Sub Btn_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
'ダブルクリックしたらセルに値を設定してユーザーフォームを閉じる

'    PbSelectValue = Btn.Caption 'ユーザーフォームのプロパティに選択した値を格納
    If PriCellArea Is Nothing Then GoTo EndEscape '入力対象のセルが設定されていない場合はセル出力の動作は行わない
    
    Call S__選択セルに値入力

EndEscape:
    Unload PriForm 'ユーザーフォームを閉じる
    
End Sub

Private Sub Btn_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
'エンターキーを押したらセルに値を設定してユーザーフォームを閉じる
'20220328追加

'    PbSelectValue = Btn.Caption 'ユーザーフォームのプロパティに選択した値を格納
    If PriCellArea Is Nothing Then GoTo EndEscape '入力対象のセルが設定されていない場合はセル出力の動作は行わない
    
    If KeyCode <> vbKeyReturn Then Exit Sub 'Enterキーが押されたかどうかの判定
    
    Call S__選択セルに値入力

EndEscape:
    Unload PriForm 'ユーザーフォームを閉じる
    
End Sub

Private Sub S__選択セルに値入力()
    Dim Dummy As Object: Set Dummy = Selection '選択中のオブジェクトの取得
    Dim SelectCell As Range
    If TypeName(Dummy) = "Range" Then 'オブジェクトの型がRangeだった場合のみ処理する
        Set SelectCell = Dummy
    Else
        Exit Sub
    End If
    
    '選択範囲が複数の場合を考慮して、選択範囲にすべて同じ値を入力
    Dim Cell As Range
    For Each Cell In SelectCell
        If Not Intersect(PriCellArea, Cell) Is Nothing Then 'セルが入力セル範囲に含まれている場合
            Cell.Value = Btn.Caption 'ボタンのキャプションの文字列をセルに入力する
        End If
    Next
End Sub