|
▼かんたん さん:
こんばんは。
>または、他に罫線を引く簡単な方法があれば、あれば、教えて下さい。
コマンドバー「書式設定」に選択セル範囲に罫線を引くアイコンがあります。
これ使ったほうがよっぽど便利だと思いますけどね!!
標準モジュールに
'=======================================================
Sub main()
Application.StatusBar = "罫線を引きます。確定はENTERキーを押してください"
Application.OnKey "~", "stop_line"
Application.OnKey "{UP}", "up_key"
Application.OnKey "{DOWN}", "down_key"
Application.OnKey "{LEFT}", "left_key"
Application.OnKey "{RIGHT}", "right_key"
End Sub
'=======================================================
Sub stop_line()
Application.OnKey "~"
Application.OnKey "{UP}"
Application.OnKey "{DOWN}"
Application.OnKey "{LEFT}"
Application.OnKey "{RIGHT}"
Application.StatusBar = False
End Sub
'=======================================================
Sub up_key()
On Error Resume Next
With ActiveCell
With .Offset(-1, 0)
.Select
If Err.Number = 0 Then
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
End If
End With
End With
End Sub
'=======================================================
Sub down_key()
On Error Resume Next
With ActiveCell
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
.Offset(1, 0).Select
End With
End Sub
'=======================================================
Sub left_key()
On Error Resume Next
With ActiveCell
With .Offset(0, -1)
.Select
If Err.Number = 0 Then
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
End If
End With
End With
End Sub
'=======================================================
Sub right_key()
On Error Resume Next
With ActiveCell
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
.Offset(0, 1).Select
End With
End Sub
として、mainを実行してみてください。
実行後に↑、↓、←、→キーの移動で罫線が引かれます。
確定はEnterキーです。
|
|