[Excel VBA] 入力規則に従ってオートコンプリート入力させる
発端
以下のように、先日のばっちりさんのつぶやきが発端です。
セルの値が変わったっていうイベントはChangeイベントだけど、入力中ってなやは無いんかな。
— バッチリ@Excel大好き仕事転がすマン (@batch_success) April 8, 2019
やっぱテキストボックス作ってKeyPressイベント実装するしかないのかな?
入力規則からオートコンプリートさせたいんやけど。
で、お勧めされたのでブログを作ってみた次第です。
動作概要
入力規則がリスト形式である場合、リスト内容を前方一致で検索して候補をコメント文で表示します。
そうしてリストが表示されている場合、カーソルキーの上下で候補から選択を行います。
カーソルキーで上下選択を開始する以前であれば、連続入力で複数文字での絞込みが可能です。
一般的なオートコンプリート機能ですね。 ただし、オートコンプリートに使える文字はアルファベットと数字だけです。
動作
以下、動画を貼り付けた投稿です。
・コメント高さ調整実装
— W.D. (@WD4096) April 15, 2019
・範囲選択してDELキー押したときにActivecellしか削除されない問題修正
・直書きの時に動作するデモを追加
あと修正するとすれば、入力規則内で文字列選択する条件を「セルに文字がある」ではなく「編集中である」ことに変更すること位。実は判定難しいのです。 pic.twitter.com/q5ajGlVB1Y
コード
本VBAではキーボードイベントをApplication.OnKeyメソッドでプロシージャーに割り当てて処理を行っています。
ブックを開いたときに割り当てを行い、ブックを閉じる際に割り当てを解除しています。
キーボードイベントに対してプロシージャーを割り当てるので、同じExcelのプロセス上であればどこでも本VBAの影響を受けます。
本コードは、前述の通り、キーボードイベントをプロシージャーに割り当てたり割り当て解除したりするコード[ThisWorkbook]と、
実際に呼び出され、オートコンプリート処理を行う[modOnKey.bas] の2つのモジュールから成り立っています。
なお、Twitterのやりとりでは、入力規則の入ったセルをカーソルキーで縦移動する際に起こる動作が修正できないとか書いてますが、修正できました。
セルが空文字列であるかどうかで判定するのではなく、「コメント文が存在するか」で判定すればよかったのです。
まあ、百聞は一見にしかずですので、とりあえずコードをごらんください。あまり綺麗なコードでなくて恥ずかしいですが。
似た内容のコードが多くて、なんか、こう、もっと、クラスでまとめたりとかあれこれできたんじゃないかとは思うのですよね。
でもまあ、とりあえずこんな感じで公開しておきます。改善するかどうかは未定です。
Option Explicit Private Sub Workbook_BeforeClose(Cancel As Boolean) 'キーボードイベントのフック処理を戻す Call Reset_OnKey End Sub Private Sub Workbook_Open() 'キーボードイベントをフックする Call Setup_OnKey End Sub
Option Explicit '参考URL 'Refernces 'Keypress events 'https://www.engram9.info/excel-vba-programming/keypress-events.html 'OnKey メソッド (Excel)(MS公式) 'https://docs.microsoft.com/ja-jp/office/vba/api/excel.application.onkey 'すごい名前生成器 'https://namegen.jp/?sex=male&country=japan&middlename=&middlename_cond=fukumu&middlename_rarity=&middlename_rarity_cond=ika&lastname=&lastname_cond=fukumu&lastname_rarity=&lastname_rarity_cond=ika&lastname_type=name&firstname=&firstname_cond=fukumu&firstname_rarity=&firstname_rarity_cond=ika&firstname_type=name Dim lngRow As Long '候補の中から選択中の行番号。0は未選択状態。 Dim strBK As String 'オートコンプリート入力されている文字列のバックアップ Sub Setup_OnKey() 'キーイベントを関数に割り当てる Application.OnKey "0", "Alpha_0_Sub" Application.OnKey "1", "Alpha_1_Sub" Application.OnKey "2", "Alpha_2_Sub" Application.OnKey "3", "Alpha_3_Sub" Application.OnKey "4", "Alpha_4_Sub" Application.OnKey "5", "Alpha_5_Sub" Application.OnKey "6", "Alpha_6_Sub" Application.OnKey "7", "Alpha_7_Sub" Application.OnKey "8", "Alpha_8_Sub" Application.OnKey "9", "Alpha_9_Sub" Application.OnKey "A", "Alpha_LA_Sub" Application.OnKey "B", "Alpha_LB_Sub" Application.OnKey "C", "Alpha_LC_Sub" Application.OnKey "D", "Alpha_LD_Sub" Application.OnKey "E", "Alpha_LE_Sub" Application.OnKey "F", "Alpha_LF_Sub" Application.OnKey "G", "Alpha_LG_Sub" Application.OnKey "H", "Alpha_LH_Sub" Application.OnKey "I", "Alpha_LI_Sub" Application.OnKey "J", "Alpha_LJ_Sub" Application.OnKey "K", "Alpha_LK_Sub" Application.OnKey "L", "Alpha_LL_Sub" Application.OnKey "M", "Alpha_LM_Sub" Application.OnKey "N", "Alpha_LN_Sub" Application.OnKey "O", "Alpha_LO_Sub" Application.OnKey "P", "Alpha_LP_Sub" Application.OnKey "Q", "Alpha_LQ_Sub" Application.OnKey "R", "Alpha_LR_Sub" Application.OnKey "S", "Alpha_LS_Sub" Application.OnKey "T", "Alpha_LT_Sub" Application.OnKey "U", "Alpha_LU_Sub" Application.OnKey "V", "Alpha_LV_Sub" Application.OnKey "W", "Alpha_LW_Sub" Application.OnKey "X", "Alpha_LX_Sub" Application.OnKey "Y", "Alpha_LY_Sub" Application.OnKey "Z", "Alpha_LZ_Sub" Application.OnKey "a", "Alpha_Sa_Sub" Application.OnKey "b", "Alpha_Sb_Sub" Application.OnKey "c", "Alpha_Sc_Sub" Application.OnKey "d", "Alpha_Sd_Sub" Application.OnKey "e", "Alpha_Se_Sub" Application.OnKey "f", "Alpha_Sf_Sub" Application.OnKey "g", "Alpha_Sg_Sub" Application.OnKey "h", "Alpha_Sh_Sub" Application.OnKey "i", "Alpha_Si_Sub" Application.OnKey "j", "Alpha_Sj_Sub" Application.OnKey "k", "Alpha_Sk_Sub" Application.OnKey "l", "Alpha_Sl_Sub" Application.OnKey "m", "Alpha_Sm_Sub" Application.OnKey "n", "Alpha_Sn_Sub" Application.OnKey "o", "Alpha_So_Sub" Application.OnKey "p", "Alpha_Sp_Sub" Application.OnKey "q", "Alpha_Sq_Sub" Application.OnKey "r", "Alpha_Sr_Sub" Application.OnKey "s", "Alpha_Ss_Sub" Application.OnKey "t", "Alpha_St_Sub" Application.OnKey "u", "Alpha_Su_Sub" Application.OnKey "v", "Alpha_Sv_Sub" Application.OnKey "w", "Alpha_Sw_Sub" Application.OnKey "x", "Alpha_Sx_Sub" Application.OnKey "y", "Alpha_Sy_Sub" Application.OnKey "z", "Alpha_Sz_Sub" Application.OnKey "{DEL}", "Alpha_DEL_Sub" Application.OnKey "{ESC}", "Alpha_ESC_Sub" Application.OnKey "{UP}", "Alpha_UP_Sub" Application.OnKey "{DOWN}", "Alpha_DOWN_Sub" Application.OnKey "{ENTER}", "Alpha_ENTER_Sub" Application.OnKey "~", "Alpha_ENTER2_Sub" End Sub Sub Reset_OnKey() 'キーイベントの解放 Application.OnKey "0", "" Application.OnKey "1", "" Application.OnKey "2", "" Application.OnKey "3", "" Application.OnKey "4", "" Application.OnKey "5", "" Application.OnKey "6", "" Application.OnKey "7", "" Application.OnKey "8", "" Application.OnKey "9", "" Application.OnKey "A", "" Application.OnKey "B", "" Application.OnKey "C", "" Application.OnKey "D", "" Application.OnKey "E", "" Application.OnKey "F", "" Application.OnKey "G", "" Application.OnKey "H", "" Application.OnKey "I", "" Application.OnKey "J", "" Application.OnKey "K", "" Application.OnKey "L", "" Application.OnKey "M", "" Application.OnKey "N", "" Application.OnKey "O", "" Application.OnKey "P", "" Application.OnKey "Q", "" Application.OnKey "R", "" Application.OnKey "S", "" Application.OnKey "T", "" Application.OnKey "U", "" Application.OnKey "V", "" Application.OnKey "W", "" Application.OnKey "X", "" Application.OnKey "Y", "" Application.OnKey "Z", "" Application.OnKey "a", "" Application.OnKey "b", "" Application.OnKey "c", "" Application.OnKey "d", "" Application.OnKey "e", "" Application.OnKey "f", "" Application.OnKey "g", "" Application.OnKey "h", "" Application.OnKey "i", "" Application.OnKey "j", "" Application.OnKey "k", "" Application.OnKey "l", "" Application.OnKey "m", "" Application.OnKey "n", "" Application.OnKey "o", "" Application.OnKey "p", "" Application.OnKey "q", "" Application.OnKey "r", "" Application.OnKey "s", "" Application.OnKey "t", "" Application.OnKey "u", "" Application.OnKey "v", "" Application.OnKey "w", "" Application.OnKey "x", "" Application.OnKey "y", "" Application.OnKey "z", "" Application.OnKey "{DEL}", "" Application.OnKey "{ESC}", "" Application.OnKey "{UP}", "" Application.OnKey "{DOWN}", "" Application.OnKey "{ENTER}", "" Application.OnKey "~", "" End Sub Sub myKeyPress(strChar As String) Dim strTemp As String Dim colMatch As Collection 'KeyEventをフックして文字を表示したり、入力規則の文字選択を楽に行う '入力規則がある場合、オートコンプリートさせる On Error Resume Next If ActiveCell.Validation.Type <> xlValidateList Then '入力規則がリスト形式でない、もしくは入力規則がない場合は、 '通常の入力処理と同等の処理になるようにキー入力を処理する。 'なお、入力規則が無い場合はIf文中の「ActiveCell.Validation.Type」でエラーになる。 '「On Error Resume Next」は「エラー時「次の行へ」進む」ので、こちらの分岐に入る。 Select Case strChar Case "{DEL}" 'セル範囲をクリア Selection.ClearContents Case "{ESC}" 'セルの値をクリア ActiveCell.Value = "" Case "{UP}" 'Upキー:選択行を1つ上へ移動 If ActiveCell.Row > 2 Then ActiveCell.Offset(-1, 0).Activate End If Case "{DOWN}" 'Downキー:選択行を1つ下へ移動 If ActiveCell.Row < 1048576 Then ActiveCell.Offset(1, 0).Activate End If Case "{ENTER}" 'Enterキー:確定して下へ移動 If ActiveCell.Row < 1048576 Then ActiveCell.Offset(1, 0).Activate End If Case Else 'キー入力をそのまま伝え、編集状態にする ActiveCell.Value = ActiveCell.Value & strChar SendKeys "{F2}" End Select Else 'オートコンプリートする Select Case strChar Case "{DEL}" 'セル範囲をクリア Selection.ClearContents 'コメント削除 Call sClearAutoComp(ActiveCell) Case "{ESC}" 'セルの値をクリア ActiveCell.Value = "" 'コメント削除 Call sClearAutoComp(ActiveCell) Case "{UP}" 'Upキー:選択行を1つ上へ移動 If Not (ActiveCell.Comment.Visible) Then '入力文字列が無い場合、通常通りの移動を行う If ActiveCell.Row > 2 Then ActiveCell.Offset(-1, 0).Activate End If Else Select Case lngRow Case 0 '何もしない Case 1 '未選択状態にする ActiveCell.Value = strBK lngRow = 0 Case Else 'オートコンプリートの候補内で移動 lngRow = lngRow - 1 Set colMatch = fCheckAutoComp(ActiveCell, strBK) ActiveCell.Value = colMatch.Item(lngRow) Set colMatch = Nothing End Select End If Case "{DOWN}" 'Downキー:選択行を1つ下へ移動 If Not (ActiveCell.Comment.Visible) Then '入力文字列が無い場合、通常通りの移動を行う If ActiveCell.Row < 1048576 Then ActiveCell.Offset(1, 0).Activate End If Else 'オートコンプリートの候補内で移動 Set colMatch = fCheckAutoComp(ActiveCell, strBK) If lngRow < colMatch.Count Then lngRow = lngRow + 1 ActiveCell.Value = colMatch.Item(lngRow) End If Set colMatch = Nothing End If Case "{ENTER}" 'コメント削除 Call sClearAutoComp(ActiveCell) 'Enterキー:確定して下へ移動 If ActiveCell.Row < 1048576 Then ActiveCell.Offset(1, 0).Activate End If Case Else '現在のオートコンプリート範囲を消去 Set colMatch = fCheckAutoComp(ActiveCell, ActiveCell.Value) If colMatch.Count > 0 Then Call sClearAutoComp(ActiveCell) End If '入力されたキーを加えた場合の文字列作成 strTemp = ActiveCell.Value & strChar '入力されたキーが入力規則にマッチしているか確認 Set colMatch = fCheckAutoComp(ActiveCell, strTemp) '入力されたキーが入力規則に含まれている個数を判定 Select Case colMatch.Count Case 0 '0個:入力を捨てる '0個:新規入力とみなしてセルをクリア Case 1 '1個:確定して下へ ActiveCell.Value = colMatch.Item(1) ActiveCell.Offset(1, 0).Activate Call sClearAutoComp(ActiveCell) Case Else '2個以上:オートコンプリート範囲を描画 '自セルには現在の入力文字列を表示 ActiveCell.Value = ActiveCell.Value & strChar 'オートコンプリート範囲を描画 Call sDisplayAutoComp(ActiveCell, colMatch) '未選択状態にセット lngRow = 0 strBK = ActiveCell.Value End Select Set colMatch = Nothing End Select End If On Error GoTo 0 End Sub Function fCheckAutoComp(objRange As Range, strInput As String) As Collection '-------------------------------------------------------------------------------- 'オートコンプリート結果を取得する '-------------------------------------------------------------------------------- '引数: ' objRange As Range:入力先セル '戻り値: ' Collection:オートコンプリート結果をコレクションで返す '-------------------------------------------------------------------------------- Dim strValidate As String Dim vntValidate As Variant Dim objValidate As Range 'Collection 初期化 Set fCheckAutoComp = New Collection '入力規則取得 strValidate = objRange.Validation.Formula1 '入力規則の先頭文字が「=」である場合、名前付き範囲が入力規則を示す If Left(strValidate, 1) = "=" Then '入力規則が「名前付き範囲」の場合 For Each objValidate In Range(Mid(strValidate, 2)) If UCase(Left(objValidate.Value, Len(strInput))) = UCase(strInput) Then '前方一致した場合、一致した単語をコレクションへ追加 Call fCheckAutoComp.Add(objValidate.Value) End If Next Else '入力規則が「文字列の列挙」の場合 '分割 For Each vntValidate In Split(strValidate, ",") '前方一致した場合、一致した単語をコレクションへ追加 If UCase(Left(CStr(vntValidate), Len(strInput))) = UCase(strInput) Then '前方一致した場合、一致した単語をコレクションへ追加 Call fCheckAutoComp.Add(CStr(vntValidate)) End If Next End If End Function Sub sDisplayAutoComp(objRange As Range, colMatch As Collection) '-------------------------------------------------------------------------------- 'オートコンプリート結果を表示する '-------------------------------------------------------------------------------- '引数: 'objRange As Range:入力中のセル 'colMatch As Collection:オートコンプリート結果 '-------------------------------------------------------------------------------- Dim lngIdx As Long Dim strDisplay As String 'オートコンプリート結果を表示 strDisplay = "" For lngIdx = 1 To colMatch.Count strDisplay = strDisplay & colMatch.Item(lngIdx) & vbLf Next '文末の改行を削除 strDisplay = Left(strDisplay, Len(strDisplay) - 1) 'コメントで表示 Call objRange.AddComment(strDisplay) objRange.Comment.Visible = True 'コメントの高さを調整 objRange.Comment.Shape.TextFrame.AutoSize = True End Sub Sub sClearAutoComp(objRange As Range) 'オートコンプリート結果を消す 'コメントをクリア Call objRange.ClearComments End Sub Sub Alpha_0_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("0") End If End Sub Sub Alpha_1_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("1") End If End Sub Sub Alpha_2_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("2") End If End Sub Sub Alpha_3_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("3") End If End Sub Sub Alpha_4_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("4") End If End Sub Sub Alpha_5_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("5") End If End Sub Sub Alpha_6_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("6") End If End Sub Sub Alpha_7_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("7") End If End Sub Sub Alpha_8_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("8") End If End Sub Sub Alpha_9_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("9") End If End Sub Sub Alpha_LA_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("A") End If End Sub Sub Alpha_LB_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("B") End If End Sub Sub Alpha_LC_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("C") End If End Sub Sub Alpha_LD_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("D") End If End Sub Sub Alpha_LE_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("E") End If End Sub Sub Alpha_LF_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("F") End If End Sub Sub Alpha_LG_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("G") End If End Sub Sub Alpha_LH_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("H") End If End Sub Sub Alpha_LI_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("I") End If End Sub Sub Alpha_LJ_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("J") End If End Sub Sub Alpha_LK_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("K") End If End Sub Sub Alpha_LL_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("L") End If End Sub Sub Alpha_LM_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("M") End If End Sub Sub Alpha_LN_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("N") End If End Sub Sub Alpha_LO_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("O") End If End Sub Sub Alpha_LP_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("P") End If End Sub Sub Alpha_LQ_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("Q") End If End Sub Sub Alpha_LR_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("R") End If End Sub Sub Alpha_LS_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("S") End If End Sub Sub Alpha_LT_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("T") End If End Sub Sub Alpha_LU_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("U") End If End Sub Sub Alpha_LV_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("V") End If End Sub Sub Alpha_LW_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("W") End If End Sub Sub Alpha_LX_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("X") End If End Sub Sub Alpha_LY_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("Y") End If End Sub Sub Alpha_LZ_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("Z") End If End Sub Sub Alpha_Sa_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("a") End If End Sub Sub Alpha_Sb_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("b") End If End Sub Sub Alpha_Sc_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("c") End If End Sub Sub Alpha_Sd_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("d") End If End Sub Sub Alpha_Se_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("e") End If End Sub Sub Alpha_Sf_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("f") End If End Sub Sub Alpha_Sg_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("g") End If End Sub Sub Alpha_Sh_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("h") End If End Sub Sub Alpha_Si_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("i") End If End Sub Sub Alpha_Sj_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("j") End If End Sub Sub Alpha_Sk_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("k") End If End Sub Sub Alpha_Sl_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("l") End If End Sub Sub Alpha_Sm_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("m") End If End Sub Sub Alpha_Sn_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("n") End If End Sub Sub Alpha_So_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("o") End If End Sub Sub Alpha_Sp_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("p") End If End Sub Sub Alpha_Sq_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("q") End If End Sub Sub Alpha_Sr_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("r") End If End Sub Sub Alpha_Ss_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("s") End If End Sub Sub Alpha_St_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("t") End If End Sub Sub Alpha_Su_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("u") End If End Sub Sub Alpha_Sv_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("v") End If End Sub Sub Alpha_Sw_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("w") End If End Sub Sub Alpha_Sx_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("x") End If End Sub Sub Alpha_Sy_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("y") End If End Sub Sub Alpha_Sz_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("z") End If End Sub Sub Alpha_UP_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("{UP}") End If End Sub Sub Alpha_DOWN_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("{DOWN}") End If End Sub Sub Alpha_ENTER_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("{ENTER}") End If End Sub Sub Alpha_ENTER2_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("{ENTER}") End If End Sub Sub Alpha_DEL_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("{DEL}") End If End Sub Sub Alpha_ESC_Sub() On Error Resume Next If TypeName(ActiveSheet) = "Worksheet" Then Call myKeyPress("{ESC}") End If End Sub