普段、FileMakerで帳票を作っているので、EnterキーやTabキーを押すと次の指定したセルにカーソルを移動させるというのは、非常に容易いのです。
今回、質問が舞い込んできまして、久々にExcel VBAを使ってのカーソル制御のスクリプトを書くことになりました。
ちなみに、スクリプトの中には、Microsoft MSDN情報や一般の方が書き下ろした情報を参考にしたソースが混ざっています。
それにしても、関数を知っていると、ここまで出来るんだなぁって、つくづく思い知らされました。
さて、本題ですが、今回のスクリプトは、今後の汎用性を考えて、
・対象となるセルの個数に依存しない
・セル番号は、固定しない
・シート保護に依存しない
・Enterキーだけでは無く、方向キーでも移動を可能にする
といったものになっています。
なお、VBAは、マクロにあたるものなので、動き出してしまうと、他のセルの編集が出来なくなってしまいます。
そこで、マクロを止めるために、プログラム内でチェックボックスを監視し、チェックが入っている時には、マクロを実行し、チェックが外れている時には、マクロを停止させる機能を追加しています。
この方法は、OKWebのnishi6様が投稿されていたテクニックを参考にさせていただきました。
まず、最初の手順として、マクロのオン／オフを制御するチェックボックスをシート上の邪魔にならない場所に設置します。
今回は、チェックを入れると「TRUE」、チェックを外すと「FALSE」を表示するセルを監視させます。
そこで、マクロ制御を行うシートをアクティブにし、
開発タブ＞挿入＞フォームコントロール
で、チェックボックスを１つ、シート上に設置します。
次に、設置したチェックボックスを右クリックし、コントトールの書式設定を選択します。
続いて、「コントロールタブ」で、「リンクするセル」を今回のスクリプト例ですと「$AO$3」にし、「チェックボックス」の設定は「オフ」にします。
なお、この「リンクするセル」のセル番号は、設置するシートによって、空いている場所がそれぞれですので、空いている場所のセル番号に変更してください。
次に、下記ソース内の
Const AdrJump As String = “C3,B4,B5,B6,L17,AB17,L19,AB19,L21,AB21,E24,I24,AA24,AF24,E25,I25,AA25,AF25,E26,I26,AA26,AF26,E27,I27,AA27,AF27,E28,I28,AA28,AF28,E29,I29,AA29,AF29”
が、データを入力したいセル番号の一覧です。
このセル番号一覧の順番に、Enterキーを押すとカーソルが移動していくという仕組みなので、入力したいセル番号をカンマ区切りで入力します。
このマクロの使い方ですが、チェックボックスをオンにしたままマクロを実行するとエラーが起きます。
そこで、エラーが起きた場合には、VBA画面でマクロを停止し、改めてマクロ「setEnableEvents」を実行してください。
これで大概は、エラーを回避出来ます。
ただ、エラーが起きることがあるのですが、それは、AdrJumpに列挙したセル番号通しを比べて、次のセル番号を確定しています。そのため、判定が出来ない時には、エラーになってしまうことがあります。
これを回避するための方法を試行錯誤していたのですが、どうも、上手い方法が思いついていません。
もし、回避出来る方法をご存じの方は教えてください。
で、ソースですが、
ブックに対するソース
「ThisWorkbook」に埋め込むソース
ーーーーーーーーーーーーーーーーーーーーーーーーーーー
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.MoveAfterReturn = True
Application.MoveAfterReturnDirection = xlDown
End Sub
Private Sub Workbook_Open()
Application.MoveAfterReturn = True
Application.MoveAfterReturnDirection = xlToRight
Application.Goto Sheets(1).Range(“C3”), True
ActiveWindow.ScrollColumn = 1
ActiveWindow.ScrollRow = 1
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーー
シートに対するソース
「Sheet1(一般用)」に埋め込むソース
※上記、一般用というのは、シート名です。
ーーーーーーーーーーーーーーーーーーーーーーーーーーー
Option Explicit
Private Declare Function GetAsyncKeyState Lib “User32.dll” (ByVal vKey As Long) As Long
Const AdrJump As String = “C3,B4,B5,B6,L17,AB17,L19,AB19,L21,AB21,E24,I24,AA24,AF24,E25,I25,AA25,AF25,E26,I26,AA26,AF26,E27,I27,AA27,AF27,E28,I28,AA28,AF28,E29,I29,AA29,AF29”
Dim Jmp1() As String
Dim Jmp2() As String
Dim DownUp As Integer
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Range(“AO3”) = False Then Exit Sub
Application.EnableEvents = False
Jmp1 = Split(getAdr(Target), “,”)
If Jmp1(0) = “” Then
DownUp = 1 – (Range(Jmp2(0)).Row < Target.Row Or Range(Jmp2(0)).Column < Target.Column)
Jmp1 = Split(getAdr(Range(Jmp2(DownUp))), “,”)
Range(Jmp2(DownUp)).Select: Jmp2 = Jmp1
Else
Jmp1 = Split(getAdr(Range(Jmp1(0))), “,”): Jmp2 = Jmp1
End If
Application.EnableEvents = True
End Sub
Function getAdr(Tgt As Range) As String
Dim wk() As String, i As Integer
wk = Split(“,” & AdrJump & “,”, “,”)
wk(0) = wk(UBound(wk) – 1)
wk(UBound(wk)) = wk(1)
getAdr = “,,”
For i = 1 To UBound(wk) – 1
If Tgt.Range(“A1”).Address(0, 0) = wk(i) Then
getAdr = wk(i) & “,” & wk(i – 1) & “,” & wk(i + 1)
Exit For
End If
Next
End Function
Sub setEnableEvents()
Erase Jmp1
Erase Jmp2
Application.EnableEvents = True
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーー
以上のようになります。
ついでに、最近では、マイクロソフトの製品もOffice365というカタチで、量販店でソフトを売るのでは無く、月額あるいは年額で、Officeを提供する形に変化してきました。
私も、普通に使っているのですが、ある意味、常に最新のOfficeが使えるので便利だったりします。
加えて、クラウドストレージとして１ＴＢが付いてくるので、結構、これも便利です。
マイクロソフトオンラインストアで購入出来ます。
コメント