'=========================================================================================
'　103　矢印キーで罫線を引く・消す
'-----------------------------------------------------------------------------------------
'【ヒント】
' このマクロは、おためし機能の動作用のコードを含んでいます。（概ね下半分）
' ★★★の行またはサブプロシージャーが、タイトル機能に関係するコードです。（概ね上半分）


'=========================================================================================
' ◆標準モジュールのコード◆
'-----------------------------------------------------------------------------------------
Option Explicit
Dim 線種 As Long                            '★★★ （長整数型にする）
Dim スタイル As Variant                     '★★★ （バリアント型にする）
Dim 太さ As Long                            '★★★ （長整数型にする）
Dim メニュー As Object                       '★★★
Dim タイトル As String
Dim ボタン As Long
Dim メッセージ As String
Dim 応答 As Variant
'=========================================================================================
Private Sub コマンドバーに罫線の種類を選択するためのメニューを追加する() '★★★
    On Error Resume Next
        CommandBars("worksheet menu bar").Controls("罫線").Delete
    On Error GoTo 0
'
    Set メニュー = CommandBars("worksheet menu bar"). _
      Controls.Add(Type:=msoControlPopup)
      メニュー.Caption = "罫線"
    With メニュー
     .Controls.Add Type:=msoControlButton
        With .Controls(1)
          .Caption = "細線"
          .OnAction = "細線"
        End With
     .Controls.Add Type:=msoControlButton
        With .Controls(2)
          .Caption = "太線"
          .OnAction = "太線"
        End With
     .Controls.Add Type:=msoControlButton
        With .Controls(3)
          .Caption = "極太線"
          .OnAction = "極太"
        End With
     .Controls.Add Type:=msoControlButton
        With .Controls(4)
          .Caption = "二重線"
          .OnAction = "二重"
        End With
     .Controls.Add Type:=msoControlButton
        With .Controls(5)
          .Caption = "点線"
          .OnAction = "点線"
        End With
    End With
End Sub
'-----------------------------------------------------------------------------------------
Sub 矢印キーに罫線を引くための機能を設定する() '★★★
    With Application
     .OnKey "+{up}", "上縦"
     .OnKey "+{down}", "下縦"
     .OnKey "+{left}", "左横"
     .OnKey "+{right}", "右横"
     .OnKey "^{up}", "削除上縦"
     .OnKey "^{down}", "削除下縦"
     .OnKey "^{left}", "削除左横"
     .OnKey "^{right}", "削除右横"
    End With
End Sub
'-----------------------------------------------------------------------------------------
Private Sub カスタムメニューとOnKeyメソッドをリセットする() '★★★
  On Error Resume Next
    CommandBars("worksheet menu bar").Controls("罫線").Delete
    With Application
     .OnKey "+{up}"
     .OnKey "+{down}"
     .OnKey "+{left}"
     .OnKey "+{right}"
     .OnKey "^{up}"
     .OnKey "^{down}"
     .OnKey "^{left}"
     .OnKey "^{right}"
    End With
  On Error GoTo 0
End Sub
'=========================================================================================
' メニューが選択されたときに罫線の種類を設定するためのマクロ
'-----------------------------------------------------------------------------------------
Sub 細線()                                  '★★★
    スタイル = xlContinuous
    線種 = xlThin
End Sub
'-----------------------------------------------------------------------------------------
Sub 太線()                                  '★★★
    スタイル = xlContinuous
    線種 = xlMedium
End Sub
'-----------------------------------------------------------------------------------------
Sub 極太()                                  '★★★
    スタイル = xlContinuous
    線種 = xlThick
End Sub
'-----------------------------------------------------------------------------------------
Sub 二重()                                  '★★★
    スタイル = xlDouble
    線種 = xlThick
End Sub
'-----------------------------------------------------------------------------------------
Sub 点線()                                  '★★★
    スタイル = xlContinuous
    線種 = xlHairline
End Sub
'=========================================================================================
' ［Sift］キー & ［矢印キー］が押されたときに実行される罫線を引くためのマクロ
'-----------------------------------------------------------------------------------------
Sub 右横()                                  '★★★
    Selection.Borders(xlEdgeTop).LineStyle = スタイル
    Selection.Borders(xlEdgeTop).Weight = 線種
    On Error Resume Next
        ActiveCell.Offset(0, 1).Activate
    On Error GoTo 0
End Sub
'-----------------------------------------------------------------------------------------
Sub 左横()                                  '★★★
    Selection.Borders(xlEdgeTop).LineStyle = スタイル
    Selection.Borders(xlEdgeTop).Weight = 線種
    On Error Resume Next
        ActiveCell.Offset(0, -1).Activate
    On Error GoTo 0
End Sub
'-----------------------------------------------------------------------------------------
Sub 上縦()                                  '★★★
    Selection.Borders(xlEdgeLeft).LineStyle = スタイル
    Selection.Borders(xlEdgeLeft).Weight = 線種
    On Error Resume Next
        ActiveCell.Offset(-1, 0).Activate
    On Error GoTo 0
End Sub
'-----------------------------------------------------------------------------------------
Sub 下縦()                                  '★★★
    Selection.Borders(xlEdgeLeft).LineStyle = スタイル
    Selection.Borders(xlEdgeLeft).Weight = 線種
    On Error Resume Next
        ActiveCell.Offset(1, 0).Activate
    On Error GoTo 0
End Sub
'=========================================================================================
' ［Ctrl］キー & ［矢印キー］が押されたときに実行される罫線を消すためのマクロ
'-----------------------------------------------------------------------------------------
Sub 削除左横()                              '★★★
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    ActiveCell.Offset(0, -1).Activate
End Sub
'-----------------------------------------------------------------------------------------
Sub 削除右横()                              '★★★
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    ActiveCell.Offset(0, 1).Activate
End Sub
'-----------------------------------------------------------------------------------------
Sub 削除上縦()                              '★★★
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    ActiveCell.Offset(-1, 0).Activate
End Sub
'-----------------------------------------------------------------------------------------
Sub 削除下縦()                              '★★★
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    ActiveCell.Offset(1, 0).Activate
End Sub
'=========================================================================================



'-----------------------------------------------------------------------------------------
Sub おためしマクロ()
    おためしメッセージを表示する
    応答 = MsgBox(メッセージ, ボタン, タイトル)
    If 応答 = vbYes Then
        コマンドバーに罫線の種類を選択するためのメニューを追加する '★★★
        細線                                   '★★★ 初期設定しておく
        矢印キーに罫線を引くための機能を設定する '★★★
        Worksheets("Sheet1").Activate
    End If
End Sub
'-----------------------------------------------------------------------------------------
Private Sub おためしメッセージを表示する()
    Worksheets("Sample").Select
    Range("A1").Select                         'カーソルを定位置へ移動する
    タイトル = "500連発 第2弾 サンプルマクロ"
    ボタン = 32 + 4                             'vbQuestion + vbYesNo
    メッセージ = "［OK］ボタンをクリックすると、" & Chr(13) & Chr(13) & _
                "矢印キーに罫線を引くための機能を設定し、コマンドバーに" & Chr(13) & Chr(13) & _
                "罫線の種類を選択するためのメニューを、追加します。" & Chr(13) & Chr(13) & _
                "（これらの設定は、終了時にリセットして復元されます）"
End Sub
'-----------------------------------------------------------------------------------------
Sub Auto_Close()
    If 応答 = vbYes Then
        カスタムメニューとOnKeyメソッドをリセットする '★★★
    End If
    Application.DisplayAlerts = False           '閉じる際に確認メッセージを出さない
    ActiveWorkbook.Close                        '現在開いているブックを閉じる
End Sub
'-----------------------------------------------------------------------------------------