Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


6680 / 13644 ツリー ←次へ | 前へ→

【43784】カーソル移動で罫線を引くには かんたん 06/10/25(水) 17:26 質問[未読]
【43789】Re:カーソル移動で罫線を引くには ichinose 06/10/25(水) 19:23 発言[未読]
【43796】有り難う御座いました。 かんたん 06/10/26(木) 8:17 お礼[未読]

【43784】カーソル移動で罫線を引くには
質問  かんたん  - 06/10/25(水) 17:26 -

引用なし
パスワード
   Excelのシート内でカーソルを移動させるだけで、罫線が引かれるプログラムって既にあるでしょうか。教えて下さい。動作概要はカーソルを右に移動させると、セルの上に罫線が引かれて行って、そのまま、下にカーソルを移動すると、セルの右に罫線が引かれるといった動作です。(上、右の取り決めはどうにでも良いのですが)
または、他に罫線を引く簡単な方法があれば、あれば、教えて下さい。
全く概略で恐縮ですが、お願い致します。

【43789】Re:カーソル移動で罫線を引くには
発言  ichinose  - 06/10/25(水) 19:23 -

引用なし
パスワード
   ▼かんたん さん:
こんばんは。
>または、他に罫線を引く簡単な方法があれば、あれば、教えて下さい。
コマンドバー「書式設定」に選択セル範囲に罫線を引くアイコンがあります。
これ使ったほうがよっぽど便利だと思いますけどね!!


標準モジュールに
'=======================================================
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キーです。

【43796】有り難う御座いました。
お礼  かんたん  - 06/10/26(木) 8:17 -

引用なし
パスワード
   ichinoseさん大変有り難う御座いました。
作業性ばっちりとなりました。
大変お世話になります。

6680 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free